| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
Audio storage, stereo swi...
Forum: Programs
Last Post: VikRam025
8 hours ago
» Replies: 3
» Views: 281
|
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: a740g
9 hours ago
» Replies: 5
» Views: 107
|
Most efficient way to bui...
Forum: General Discussion
Last Post: ahenry3068
10 hours ago
» Replies: 9
» Views: 124
|
QBJS - ANSI Draw
Forum: QBJS, BAM, and Other BASICs
Last Post: madscijr
10 hours ago
» Replies: 4
» Views: 123
|
_CONSOLEINPUT is blocking
Forum: General Discussion
Last Post: mdijkens
Yesterday, 06:26 PM
» Replies: 6
» Views: 94
|
Fun with Ray Casting
Forum: a740g
Last Post: a740g
Yesterday, 05:50 AM
» Replies: 10
» Views: 230
|
Very basic key mapping de...
Forum: SMcNeill
Last Post: a740g
Yesterday, 02:33 AM
» Replies: 1
» Views: 52
|
Methods in types
Forum: General Discussion
Last Post: bobalooie
Yesterday, 01:02 AM
» Replies: 0
» Views: 57
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
01-16-2025, 10:23 AM
» Replies: 3
» Views: 117
|
Extended KotD #23 and #24...
Forum: Keyword of the Day!
Last Post: SMcNeill
01-16-2025, 09:51 AM
» Replies: 0
» Views: 54
|
|
|
Cartesian axes automatically scaled and finding Y on a graph, given the X. |
|
Posted by: bartok - 08-22-2022, 12:26 PM - Forum: Utilities
- No Replies
|
 |
![[Image: Immagine.png]](https://i.ibb.co/M18ZfH5/Immagine.png)
Code: (Select All) 'this utility:
'1. given X! and Y! values (the maximum values in abscissa and ordinate of a graph that generally is an output of a
' part of the code that makes calculations), it automatically scales the Cartesian plane so that (0,0) is at 40
' pixels in abscissa and ordinate directions from the bottom left corner and the axes end 40 pixels beyond X! and Y!,
' maintaining 40 pixels from the border;
'2. it draws on the graph the point (X1!,Y!) (where X1! is the X value corresponding to Y! on the graph), it prints
' its values and it draws 2 dashed lines up to the axes;
'3. it asks an X value on which calculate the corresponding Y value;
'4. it draws on the graph the point (X,Y), it prints its values and it draws 2 dashed lines up to the axes.
OPTION BASE 1
CONST R& = _RGB32(255, 0, 0)
CONST G& = _RGB32(0, 255, 0)
CONST B& = _RGB32(0, 0, 255)
CONST white& = _RGB32(255, 255, 255)
CONST yellow& = _RGB32(255, 255, 0)
CONST grey& = _RGB32(127, 127, 127)
CONST azure& = _RGB32(0, 255, 255)
DIM SHARED DESKTOPWIDTH%, DESKTOPHEIGHT%
DIM schermo&, grafico&
DIM X! 'maximum value in abscissa of a graph. generally they are both an output of a part of the code that makes calculations.
DIM Y! 'maximum value in ordinate of a graph. generally they are both an output of a part of the code that makes calculations.
DIM X1! 'X value corresponding to Y! on the graph. generally they are both an output of a part of the code that makes calculations.
DIM L%, H%
DESKTOPWIDTH% = _DESKTOPWIDTH \ 2
DESKTOPHEIGHT% = _DESKTOPHEIGHT \ 2
L% = DESKTOPWIDTH%: H% = L% \ 1.62 'L e H are defined to create a golden rectangle.
schermo& = _NEWIMAGE(DESKTOPWIDTH%, DESKTOPHEIGHT%, 32)
grafico& = _NEWIMAGE(L%, H%, 32)
SCREEN schermo&
'START OF THE EXAMPLE++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
VIEW PRINT 1 TO 2
X! = 44.66777 '----------------------------------------------------------------> it is generally an output of a part of the code.
Y! = 100.434667 '--------------------------------------------------------------> it is generally an output of a part of the code.
X1! = 3 '----------------------------------------------------------------------> it is the X value corresponding to Y! on the graph and it is generally an output of a part of the code.
CALL DisegnaAssi("X", "Y", X!, Y!, grafico&, R&, white&, white&, yellow&) '----> point 1 of the description.
CALL DisegnaValore(X1!, Y!, azure&, azure&, white&) '--------------------------> point 2 of the description.
LINE (dx!, dy!)-(dx! + X1!, dy! + Y!), yellow& '-------------------------------> it can be any kind of graph generated by a part of the code.
LINE -(dx! + X!, dy!), yellow& '-----------------------------------------------> it can be any kind of graph generated by a part of the code.
_PUTIMAGE (0, (DESKTOPHEIGHT% - _HEIGHT(grafico&) - 16)), grafico&, schermo&
CALL DisegnaPortata(X!, grafico&, schermo&) '----------------------------------> points 3 and 4 of the description.
VIEW PRINT
'END OF THE EXAMPLE++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
SLEEP
_FREEIMAGE grafico&
SYSTEM
'--------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------
SUB ScalaOrigine (scala~%, origine~%, X!, Y!, immagine&)
'scala~%: if 1, it activates the routine "scala", if 0, it does not activate it;
'origine~%: if 1, it activates the routine "origine", if 0, it does not activate it;
'X!: maximum value on the abscissa. it could be the last value of a vector or the last value of a vector that is greater than a given theshold;
'Y!: maximum value in ordinate.
'So, generally they aren't both directly given as in this example.
'immagine&: is the image on which the point (0,0) is set by the routine "origine".
'this subroutine scales the image via WINDOW in an iterative way, so that the point "1" of the description could be reached.
'generally this SUB is CALLed by the SUB "DisegnaAssi", as we can see in the main code. In that case, both routines "scala" and "origine"
'are executed, as to say whenever a new graph is made.
'However, in some cases, it could be necessary to make further graphs on an image already existing without changing the scale. In this
'case "ScalaOrigine" 'is CALLed alone with parameters (0,1,0,0,immagine&).
'In other cases, in which we already have a graph properly scaled, it could be necessary to add a further graph not in scale compared to
'the first. In that case "ScalaOrigine" is CALLed alone with parameters (1,1,Kx*X!,Ky*Y!, immagine&) where Kx and Ky are appropriate
'coefficient in order to have the wanted result.
SHARED dx%, dy%
SHARED dx!, dy!
DIM fattoreX!, fattoreY!
fattoreX! = 1
fattoreY! = 1
IF scala~% = 0 AND origine~% = 1 THEN GOSUB origine
IF scala~% = 1 AND origine~% = 1 THEN
DO
GOSUB scala
GOSUB origine
IF Y! * fattoreY! >= dy! + Y! + dy! + dy! THEN
IF X! * fattoreX! >= dx! + X! + dx! + dx! THEN
EXIT DO
ELSE
fattoreX! = fattoreX! + 0.01
END IF
ELSE
fattoreY! = fattoreY! + 0.01
END IF
LOOP
END IF
EXIT SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------
scala:
WINDOW 'it closes other WINDOWs already opened with this routine.
WINDOW (0, 0)-(X! * fattoreX!, Y! * fattoreY!)
RETURN
'--------------------------------------------------------------------------------------------------------------------------------------------------
origine:
dx% = 39
dx! = PMAP(dx%, 2)
dy% = _HEIGHT(immagine&) - 1 - dx%
dy! = PMAP(dy%, 3)
RETURN
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------
SUB DisegnaAssi (X$, Y$, X!, Y!, immagine&, ColoreCartiglio&, ColoreAssi&, ColoreTacca&, ColoreNumeri&)
SHARED dx%, dy%
SHARED dx!, dy!
DIM x%, y% 'for marks positioning on the axes.
DIM taccaX!, taccaY! 'they define the range with which to draw the marks.
_DEST immagine&: CLS
SELECT CASE X!
CASE IS >= 12
taccaX! = X! \ 6
CASE IS <= 1
taccaX! = 0.25
CASE ELSE
taccaX! = 0.5
END SELECT
SELECT CASE Y!
CASE IS >= 12
taccaY! = Y! \ 6
CASE IS <= 1
taccaY! = 0.25
CASE ELSE
taccaY! = 0.5
END SELECT
WINDOW
LINE (0, 0)-(_WIDTH(immagine&) - 1, _HEIGHT(immagine&) - 1), ColoreCartiglio&, B
CALL ScalaOrigine(1, 1, X!, Y!, immagine&)
LINE (dx!, dy! + Y! + dy!)-(dx!, dy!), ColoreAssi&: LINE -(dx! + X! + dx!, dy!), ColoreAssi& 'it draws the axis.
PSET (dx!, dy! + Y! + dy!), ColoreAssi&: DRAW "F20": PSET (dx!, dy! + Y! + dy!), ColoreAssi&: DRAW "G20" 'it draws the arrow of the ordinate axis.
PSET (dx! + X! + dx!, dy!), ColoreAssi&: DRAW "G20": PSET (dx! + X! + dx!, dy!), ColoreAssi&: DRAW "H20" 'it draws the arrow of the abscissa axis.
COLOR ColoreNumeri&
_PRINTSTRING (PMAP(dx! + X! + dx!, 0), dy%), X$
_PRINTSTRING (dx%, PMAP(dy! + Y! + dy!, 1) - dx% \ 2), Y$
_PRINTSTRING (dx% \ 4, dy% - 7), "0"
i% = 1
WHILE i% * taccaX! <= X! 'it draws and prints the marks and the corresponding values on the abscissa axis.
LINE (dx! + i% * taccaX!, PMAP(dy% + 5, 3))-(dx! + i% * taccaX!, PMAP(dy% - 5, 3)), ColoreTacca& 'it draws the marks in abscissa direction of 11 pixels lenght.
x% = PMAP(dx! + i% * taccaX!, 0)
_PRINTSTRING (x% - 3 * LEN(_TRIM$(STR$(i% * taccaX!))), _HEIGHT(immagine&) - 1 - dx% + 5), _TRIM$(STR$(i% * taccaX!)) 'it prints the value corresponding
'to the mark, considering that the single character is 8 bits large.
i% = i% + 1
WEND
i% = 1
WHILE i% * taccaY! <= Y! 'it draws and prints the marks and the corresponding values on the ordinate axis.
LINE (PMAP(dx% - 5, 2), dy! + i% * taccaY!)-(PMAP(dx% + 5, 2), dy! + i% * taccaY!), ColoreTacca& 'it draws the marks in ordinate direction of 11 pixels lenght.
y% = PMAP(dy! + i% * taccaY!, 1)
_PRINTSTRING (dx% \ 4, y% - 7), _TRIM$(STR$(i% * taccaY!)) 'it spaces the value of the mark of 10 pixels from the border and it centrates it on the mark, considering that the chararacter in 16 pixels hight.
i% = i% + 1
WEND
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------
SUB DisegnaValore (X!, Y!, ColoreLinea&, ColorePunto&, ColoreTesto&)
'subroutine which draws on the graph the point (X!,Y!), it prints its values and it draws 2 dashed lines up to the axes.
'In this case:
'X!: it is X value corresponding to Y!
'Y!: it is the maximum.
'Even in this case X! and Y! generally are not given, but they are the result of a part of the code that search them.
SHARED dx%, dy%
SHARED dx!, dy!
DIM x%, y% 'for the positioning on the graph of the point (X!,Y!)
CIRCLE (dx! + X!, dy! + Y!), PMAP(3, 2), ColorePunto&
PAINT (dx! + X! + PMAP(0.5, 2), dy! + Y! + PMAP(0.5, 2)), ColorePunto&
LINE (dx!, dy! + Y!)-(dx! + X!, dy! + Y!), ColoreLinea&, , 65520 '=1111111111110000 where each character is a pixel. 1: the pixel is drawn, 0: the pixel is empty. so we have a dashed line with 12 pixels drawn
'every 4 empty pixels.
LINE -(dx! + X!, dy!), ColoreLinea&, , 65520
x% = PMAP(dx! + X!, 0)
y% = PMAP(dy! + Y!, 1)
COLOR ColoreTesto&
_PRINTSTRING (x% - 4, y% - 16), "(" + _TRIM$(STR$(Arrotonda!(X!))) + ";" + _TRIM$(STR$(Arrotonda!(Y!))) + ")"
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------
SUB DisegnaPortata (X!, immagine&, destinazione&)
'subroutine that uses the subroutine "DisegnaValore" in order to draw and print on the graph the point (X,Y) and its value. the dashed lines are animated.
'in order to find the Y value, it asks the X value. Then, starting from the pixel corresponding to Y=0 (y%), it proceeds pixel by pixel decreasing the
'value of y%, until a yellow pixel of the graph is found. While the DO-LOOP cycle goes on searching the yellow pixel, a dashed line is drawn and displayed.
'similarly a dashed line is drawn towards the ordinate axis, while searching a white pixel.
SHARED dx%, dy%
SHARED dx!, dy!
DIM ore!
DIM x%, y% 'for the drawn of the dashed lines in real time.
_DEST schermo&
DO
CLS 2
INPUT "- Type an X value: ", ore!
LOOP WHILE ore! > X! 'it doesn't axcept values greater than the maximum abscissa value of the graph.
IF ore! = 0 THEN EXIT SUB
_DEST immagine&
_SOURCE immagine&
CALL ScalaOrigine(0, 1, 0, 0, immagine&)
x% = PMAP(dx! + ore!, 0)
y% = PMAP(dy!, 1)
DO
y% = y% - 1
IF POINT(dx! + ore!, PMAP(y%, 3)) = azure& THEN 'in this case the user has chosen an X value corresponding to X!, which is already displayed.
_DEST schermo&
EXIT SUB
END IF
IF POINT(dx! + ore!, PMAP(y%, 3)) = yellow& THEN EXIT DO 'the yellow pixel corresponds to the value of searched value.
LINE (dx! + ore!, dy!)-(dx! + ore!, PMAP(y%, 3)), grey&, , 65520 'it draws the dashed line from the abscissa to the yello pixel. The animation is provided by the following _PUTIMAGE.
_PUTIMAGE (0, (DESKTOPHEIGHT% - _HEIGHT(immagine&) - 16)), immagine&, destinazione&
LOOP
portata! = PMAP(y%, 3) - dy!
CALL DisegnaValore(ore!, portata!, 0, 0, white&) 'via subroutine "DisegnaValore", the valune of (X,Y) is displayed.
i% = 2
DO
x% = x% - 1
IF POINT(PMAP(x%, 2), PMAP(y%, 3)) = white& THEN EXIT DO 'the condition in order to exit the LOOP is the identification of a white pixel which belongs to the ordinate axis.
LINE (dx! + ore!, PMAP(y%, 3))-(PMAP(x%, 2), PMAP(y%, 3)), grey&, , 65520 'an animated dashed line is drawn towards the ordinate axis, as before.
_PUTIMAGE (0, (DESKTOPHEIGHT% - _HEIGHT(immagine&) - 16)), immagine&, destinazione&
LOOP
_DEST schermo&
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------
FUNCTION Arrotonda! (num!)
Arrotonda! = _ROUND(num! * 100) / 100
END FUNCTION
|
|
|
| KISS MY ASCII GOOD PI! |
|
Posted by: Pete - 08-22-2022, 09:43 AM - Forum: General Discussion
- Replies (32)
|
 |
So I updated my pi approximation routine with my faster string math addition/subtraction/multiplication routine and got...
3.14149 and change in about 15-minutes. Now my system is Mem/CPU challenged, so I suspect your systems might be able to turn and burn the 10,000 iterations it took to achieve that in under 5-minutes. Anyway pi by Liebniz's method (1 - (1/3) + (1/5)... = pi /4) appears valid, but to get anything close to accurate would take maybe what, 50,000 iterations? Also, I cheated a bit by not increasing the digit limit to over 1,000 and I used the betatest% variable to direct the routine to cut the final division calculation to 32 digits. I did that because I have not addressed a faster way to do long division by chunks or some other method in my new improved string math routines. If I left that last cheat out, the difference would not be all that great and the calculation time would probably be a few hours and burn up the CPU.
Anyway, if you are impatient, just play around with lowering the loops. It will do 500 very fast.
Code: (Select All) DIM SHARED betatest%: betatest% = -2
WIDTH 160, 43
_SCREENMOVE 0, 0
limit&& = 128
j = -1
FOR i = 1 TO 10000
IF betatest% <> -1 THEN IF i MOD 100 = 0 THEN PRINT "Loop"; i
j = j + 2
IF oldd$ = "" THEN
d$ = "1": oldd$ = "1": oldn$ = "1": n$ = "1"
ELSE
d$ = LTRIM$(STR$(j))
' 2nd denominator * 1st numerator.
a$ = d$: b$ = oldn$: op$ = "*"
CALL string_math(a$, op$, b$, x$, limit&&)
m1$ = x$
' 1st denominator * 2nd numerator.
a$ = oldd$: b$ = n$
CALL string_math(a$, op$, b$, x$, limit&&)
m2$ = x$
' Get common denominator
a$ = d$: b$ = oldd$
CALL string_math(a$, op$, b$, x$, limit&&)
d$ = x$
a$ = m1$: b$ = m2$: IF i / 2 = i \ 2 THEN op$ = "-" ELSE op$ = "+"
CALL string_math(a$, op$, b$, x$, limit&&)
REM PRINT "oldn$ = "; oldn$; " oldd$ = "; oldd$, "n$ = "; x$; " d$ = "; d$
IF betatest% = -1 THEN PRINT "n$ = "; x$; " d$ = "; d$;: COLOR 14, 0: PRINT " "; op$; " 1/"; LTRIM$(STR$(j)): COLOR 7, 0
oldn$ = x$: oldd$ = d$
END IF
NEXT
n$ = x$
a$ = x$: b$ = d$: op$ = "/"
IF betatest% = -1 THEN ' Reduce for speed increase
limit&& = 32
j&& = LEN(b$) - LEN(a$)
a$ = MID$(a$, 1, 32)
b$ = MID$(b$, 1, j&& + 32)
PRINT: PRINT "Numerator = "; a$; " "; "Denominator = "; b$
ELSE
IF betatest% = -2 THEN
limit&& = 32
j&& = LEN(b$) - LEN(a$)
a$ = MID$(a$, 1, 32)
b$ = MID$(b$, 1, j&& + 32)
PRINT: PRINT "Numerator = "; a$; " "; "Denominator = "; b$
ELSE
PRINT "Begin long division...": PRINT
END IF
END IF
CALL string_math(a$, op$, b$, x$, limit&&)
a$ = x$: b$ = "4": op$ = "*"
CALL string_math(a$, op$, b$, x$, limit&&)
PRINT: PRINT "pi = "; x$
END
SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, limit&&)
DIM AS _INTEGER64 a, c, aa, cc, s, ss
SELECT CASE operator$
CASE "+", "-"
GOTO string_add_subtract_new
CASE "*"
GOTO string_multiply_new
CASE "/"
GOTO string_divide
CASE ELSE
PRINT "Error, no operator selected. operator$ = "; operator$
END SELECT
string_divide:
terminating_decimal% = 0: divsign% = 0: divremainder& = 0: divremainder$ = "": divplace& = 0: divplace2& = 0: quotient$ = "": divcarry& = 0
operationdivision% = -1
divbuffer& = LEN(stringmathb$) - LEN(stringmatha$)
IF divbuffer& < 0 THEN divbuffer& = 0
d2dividend$ = stringmatha$
d1divisor$ = stringmathb$
IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": divsign% = 0: operationdivision% = 0: EXIT SUB
IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
IF LEFT$(d2dividend$, 1) = "-" THEN
IF divsign% THEN
divsign% = 0
ELSE
divsign% = -1
END IF
d2dividend$ = MID$(d2dividend$, 2)
END IF
IF INSTR(d1divisor$, ".") <> 0 THEN
DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
LOOP
divplace& = LEN(d1divisor$) - INSTR(d1divisor$, ".")
d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
DO UNTIL LEFT$(d1divisor$, 1) <> "0"
d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
LOOP
END IF
IF INSTR(d2dividend$, ".") <> 0 THEN
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.
divplace2& = INSTR(d2dividend$, ".")
DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
LOOP
d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
ELSE
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.
divplace& = 0
END IF
DO
DO
divremainder& = divremainder& + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder&, 1)
IF MID$(d2dividend$, divremainder&, 1) = "" THEN
IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN
divflag% = -1
terminating_decimal% = -1
EXIT DO
END IF
divcarry& = divcarry& + 1
IF divcarry& = 1 THEN divplace3& = divremainder& - 1
IF divcarry& > limit&& + 1 + divbuffer& THEN
divflag% = -2: EXIT DO
END IF
divremainder$ = divremainder$ + "0" ' No more digits to bring down.
END IF
IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
quotient$ = quotient$ + "0"
LOOP
IF divflag% THEN divflag% = 0: EXIT DO
FOR div_i% = 9 TO 1 STEP -1
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply_new: m_product$ = runningtotal$
tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
DO
IF LEN(tempcutd$) = 1 THEN EXIT DO
IF LEFT$(tempcutd$, 1) = "0" THEN
tempcutd$ = MID$(tempcutd$, 2)
ELSE
EXIT DO
END IF
LOOP
IF LEN(tempcutd$) > LEN(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
NEXT
quotient$ = quotient$ + LTRIM$(STR$(div_i%))
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply: m_product$ = runningtotal$
operator$ = "-"
stringmatha$ = divremainder$
stringmathb$ = m_product$
GOSUB string_add_subtract_new
stringmatha$ = runningtotal$ '*'
divremainder$ = stringmatha$
operator$ = "/"
LOOP
IF divplace& = 0 AND divplace2& = 0 THEN divplace& = divplace3&
IF divplace2& THEN divplace& = divplace& + divplace2& - 1
IF quotient$ = "" THEN divplace& = 0 ' dividend is zero.
IF divplace& OR divplace2& THEN
quotient$ = MID$(quotient$, 1, divplace&) + "." + MID$(quotient$, divplace& + 1)
DO UNTIL RIGHT$(quotient$, 1) <> "0"
quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off trailing zeros
LOOP
IF RIGHT$(quotient$, 1) = "." THEN quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off abandoned decimal.
END IF
DO UNTIL LEFT$(quotient$, 1) <> "0"
quotient$ = MID$(quotient$, 2) ' Strip off leading zeros
LOOP
IF quotient$ = "" THEN quotient$ = "0": divsign% = 0
operationdivision% = 0
stringmathb$ = quotient$: quotient$ = ""
IF stringmathb$ = "overflow" THEN divsign% = 0: operationdivision% = 0: EXIT SUB
runningtotal$ = stringmathb$: stringmathb$ = ""
IF divsign% THEN runningtotal$ = "-" + runningtotal$
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
operationdivision% = 0
EXIT SUB
'------------------------------------------------------------------------
string_multiply:
m_decimal_places& = 0: m_product$ = ""
fac1$ = stringmatha$: fac2$ = stringmathb$ ' Make numbers whole numbers and remove any - sign.
IF LEFT$(fac1$, 1) = "-" THEN fac1$ = MID$(fac1$, 2): m_sign% = -1
IF LEFT$(fac2$, 1) = "-" THEN fac2$ = MID$(fac2$, 2): IF m_sign% THEN m_sign% = 0 ELSE m_sign% = -1
IF INSTR(fac1$, ".") <> 0 THEN m_decimal_places& = LEN(fac1$) - INSTR(fac1$, "."): fac1$ = MID$(fac1$, 1, INSTR(fac1$, ".") - 1) + MID$(fac1$, INSTR(fac1$, ".") + 1)
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)
FOR m_i& = LEN(fac2$) TO 1 STEP -1 ' Multiply each charater top and bottom.
m_k& = m_l&
m_x2$ = MID$(fac2$, m_i&, 1)
FOR m_j& = LEN(fac1$) TO 1 STEP -1
m_x1$ = MID$(fac1$, m_j&, 1)
IF m_product$ <> "" THEN
m_add$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0")
m_t& = 0: m_xproduct$ = "": m_carry% = 0
DO ' Add multiplied characters together.
m_x3$ = MID$(m_add$, LEN(m_add$) - m_t&, 1)
m_x4$ = MID$(m_product$, LEN(m_product$) - m_t&, 1)
IF m_x3$ = "" AND m_x4$ = "" THEN
IF m_carry% THEN m_xproduct$ = "1" + m_xproduct$
EXIT DO
END IF
m_g% = VAL(m_x3$) + VAL(m_x4$) + m_carry%
IF m_g% >= 10 THEN m_g% = m_g% - 10: m_carry% = 1 ELSE m_carry% = 0
m_xproduct$ = LTRIM$(STR$(m_g%)) + m_xproduct$
m_t& = m_t& + 1
LOOP
m_product$ = m_xproduct$: m_xproduct$ = ""
ELSE
m_product$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0") ' First loop makes variable here.
END IF
m_k& = m_k& + 1 ' Adds trailing zeros multiplication
NEXT
m_l& = m_l& + 1 ' Used to reset value for m_k& adding one trailing zer for each loop.
NEXT
fac1$ = "": fac2$ = "": m_l& = 0: m_k& = 0: m_t& = 0
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.
IF m_decimal_places& AND m_product$ <> "0" THEN ' Replace any decimal point.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - m_decimal_places&) + "." + MID$(m_product$, LEN(m_product$) - m_decimal_places& + 1)
END IF
DO UNTIL LEFT$(m_product$, 1) <> "0" ' Remove leading zeros.
m_product$ = MID$(m_product$, 2)
LOOP
IF m_decimal_places& THEN
DO UNTIL RIGHT$(m_product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1)
LOOP
END IF
IF m_product$ = "" THEN m_product$ = "0": m_sign% = 0
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.
IF operationdivision% THEN m_sign% = 0: RETURN
stringmathb$ = m_product$: m_product$ = ""
IF stringmathb$ = "overflow" THEN EXIT SUB
runningtotal$ = stringmathb$: stringmathb$ = ""
IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
EXIT SUB
string_add_subtract:
IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
sumplace& = LEN(stringmatha$) - INSTR(stringmatha$, ".")
stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
END IF
IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
numplace& = LEN(stringmathb$) - INSTR(stringmathb$, ".")
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
END IF
IF sumplace& > numplace& THEN addsubplace& = sumplace& ELSE addsubplace& = numplace&
IF sumplace& > addsubplace& THEN
stringmatha$ = stringmatha$ + STRING$(sumplace& - addsubplace&, "0")
ELSEIF addsubplace& > sumplace& THEN
stringmatha$ = stringmatha$ + STRING$(addsubplace& - sumplace&, "0")
END IF
IF numplace& > addsubplace& THEN
stringmathb$ = stringmathb$ + STRING$(numplace& - addsubplace&, "0")
ELSEIF addsubplace& > numplace& THEN
stringmathb$ = stringmathb$ + STRING$(addsubplace& - numplace&, "0")
END IF ' END Decimal evaluations.
IF LEFT$(stringmatha$, 1) = "-" THEN sign_input$ = "-" ELSE sign_input$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN sign_total$ = "-" ELSE sign_total$ = "+"
addsubsign% = 0
SELECT CASE sign_input$ + operator$ + sign_total$
CASE "+++", "+--"
operator$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
CASE "++-", "+-+"
operator$ = "-"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
GOSUB string_comp
IF gl% < 0 THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
CASE "---", "-++"
operator$ = "-"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
GOSUB string_comp
IF gl% < 0 THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
CASE "--+", "-+-"
operator$ = "+"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
addsubsign% = -1
END SELECT
IF LEN(stringmatha$) > LEN(stringmathb$) THEN
stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
END IF
addsubx1$ = ""
SELECT CASE operator$
CASE "+", "="
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) + VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
GOSUB replace_decimal
CASE "-"
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) - VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replace_decimal
DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
addsubx1$ = MID$(addsubx1$, 2)
LOOP
IF addsubx1$ = "" THEN
addsubx1$ = "0": addsubsign% = 0
ELSE
IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
END IF
END SELECT
IF addsubsign% THEN
IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
END IF
stringmatha$ = addsubx1$: addsubx1$ = ""
IF operationdivision% THEN RETURN
stringmathb$ = stringmatha$: stringmatha$ = ""
IF LEFT$(stringmathb$, 1) = "-" THEN
stringmathb$ = MID$(stringmathb$, 2)
n2sign$ = "-"
ELSE
n2sign$ = ""
END IF
IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB
runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
EXIT SUB
'------------------------------------------------------------------------
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$ = ""
DO
i&& = i&& + s
x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
x2$ = MID$(b$, LEN(b$) - i&& + 1, s)
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
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
IF operationdivision% THEN RETURN
EXIT SUB
'------------------------------------------------------------------------
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$
DO
h&& = h&& + s: i&& = 0
x2$ = MID$(b$, LEN(b$) - h&& + 1, s)
WHILE -1
i&& = i&& + s
x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
a = VAL(sign_a$ + x1$) * VAL(sign_b$ + 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$
IF i&& >= LEN(a$) AND c = 0 THEN EXIT WHILE
WEND
jj&& = jj&& + 1
IF jj&& > 1 THEN
ii&& = 0: cc = 0
aa$ = holdaa$
bb$ = z$ + STRING$((jj&& - 1) * s, "0")
DO
ii&& = ii&& + ss
xx1$ = MID$(aa$, LEN(aa$) - ii&& + 1, ss)
xx2$ = MID$(bb$, LEN(bb$) - ii&& + 1, ss)
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 z$ = "" OR z$ = "0" THEN z$ = "0": ELSE z$ = sign$ + z$
decimal% = 0: sign$ = ""
runningtotal$ = z$
IF operationdivision% THEN RETURN
EXIT SUB
replace_decimal:
IF addsubplace& THEN
addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
addsubplace& = addsubplace& - 1
LOOP
IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
END IF
RETURN
string_comp:
DO
' Remove trailing zeros after a decimal point.
IF INSTR(acomp$, ".") THEN
DO UNTIL RIGHT$(acomp$, 1) <> "0" AND RIGHT$(acomp$, 1) <> "." AND RIGHT$(acomp$, 1) <> "-"
acomp$ = MID$(acomp$, 1, LEN(acomp$) - 1)
LOOP
END IF
IF INSTR(bcomp$, ".") THEN
DO UNTIL RIGHT$(bcomp$, 1) <> "0" AND RIGHT$(bcomp$, 1) <> "." AND RIGHT$(bcomp$, 1) <> "-"
bcomp$ = MID$(bcomp$, 1, LEN(bcomp$) - 1)
LOOP
END IF
IF MID$(acomp$, 1, 2) = "-0" OR acomp$ = "" OR acomp$ = "-" THEN acomp$ = "0"
IF MID$(bcomp$, 1, 2) = "-0" OR bcomp$ = "" OR bcomp$ = "-" THEN bcomp$ = "0"
' A - and +
IF LEFT$(acomp$, 1) = "-" THEN j% = -1
IF LEFT$(bcomp$, 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(acomp$, ".")
k% = INSTR(bcomp$, ".")
IF j% = 0 AND k% THEN
IF acomp$ = "0" THEN gl% = -1 ELSE gl% = 1
EXIT DO
END IF
IF k% = 0 AND j% THEN
IF bcomp$ = "0" THEN gl% = 1 ELSE gl% = -1
EXIT DO
END IF
' Both decimals.
IF j% THEN
IF acomp$ > bcomp$ THEN
gl% = 1
ELSEIF acomp$ = bcomp$ THEN gl% = 0
ELSEIF acomp$ < bcomp$ THEN gl% = -1
END IF
EXIT DO
END IF
' Both positive or both negative whole numbers.
SELECT CASE LEN(acomp$)
CASE IS < LEN(bcomp$)
gl% = -1
CASE IS = LEN(bcomp$)
IF acomp$ = bcomp$ THEN
gl% = 0
ELSEIF acomp$ > bcomp$ THEN gl% = 1
ELSEIF acomp$ < bcomp$ THEN gl% = -1
END IF
CASE IS > LEN(bcomp$)
gl% = 1
END SELECT
EXIT DO
LOOP
RETURN
END SUB
SUB string_compare (compa$, compb$, gl%)
DO
' 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: PRINT "1*": EXIT DO
IF j% = 0 AND k% THEN gl% = 1: PRINT "2*": 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: PRINT "4*" ELSE gl% = 1: PRINT "5*"
EXIT DO
END IF
IF k% = 0 AND j% THEN
IF compb$ = "0" THEN gl% = 1: PRINT "6*" ELSE gl% = -1: PRINT "7*"
EXIT DO
END IF
' Both decimals.
IF j% THEN
IF compa$ > compb$ THEN
gl% = 1: PRINT "8*"
ELSEIF compa$ = compb$ THEN gl% = 0: PRINT "9*"
ELSEIF compa$ < compb$ THEN gl% = -1: PRINT "10*"
END IF
EXIT DO
END IF
' 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 Sorry about the title, Steve. (I might have got his hopes up it meant I was de-partying!) 
|
|
|
|
| Rookie Rainfall |
|
Posted by: james2464 - 08-22-2022, 01:11 AM - Forum: Programs
- Replies (7)
|
 |
You can use 'w' and 's' to adjust the display speed
Code: (Select All) 'Rookie Rainfall
'james2464
Dim scx As Integer
Dim scy As Integer
Dim res As Integer
scx = 500
scy = 400
res = 1
Screen _NewImage(scx, scy, 32)
$Resize:Smooth
Dim c0(100) As Long
'cyan
c0(0) = _RGB(0, 0, 0) 'black
c0(2) = _RGB(0, 127, 255) 'cyan
c0(3) = _RGB(0, 45, 90) 'cyan
c0(4) = _RGB(0, 30, 60) 'cyan
c0(5) = _RGB(0, 20, 40) 'cyan
c0(6) = _RGB(0, 10, 20) 'cyan
c0(7) = _RGB(0, 5, 10) 'cyan
Randomize Timer
'starting speed delay value
Dim dv As Long
dv = 20
'screen sized array
Dim a(scx, scy) As Integer
'set to zero
For f = 0 To scx
For s = 0 To scy
a(f, s) = 0
Next s
Next f
'fill screen with colour c0(0) pixels
For s = 0 To scx
For f = 0 To scy
PSet (s, f), c0(a(s, f))
Next
Next
'smaller array size for higher value of "res"
scx2 = scx / res
scy2 = scy / res
Dim dtx(2000) As Integer 'stores droplet position along x axis
Dim dty(2000) As Integer 'stores droplet postion along y axis
Dim dx, ct As Integer 'used in loops when "drying"
Dim dice1 As Long 'used to randomize things
Dim p1~& 'used to interpret pixel colours when "drying"
flag = 0
ct = 0
ctmax = 150 'max number of active droplets
rain = 488 'starting value for rainflow
dry1 = 0
dryrate = 0
'dtx array -1 value makes the position inactive...higher than -1 is active
'initialize by setting to -1
For j = 1 To scx
dtx(j) = -1
Next j
'used to separate pixel colours from _Point to _Red32 _Blue32 etc
Dim a99, b99, c99, d99 As Integer
Do
t = Int(Rnd * 500)
If t > 480 Then 'sometimes allow for changes in the amount of rainfall
flowchange = Int(Rnd * 3) - 1 'randomize the change in amount of rain. Even overall with minor ups and downs
rain = rain + flowchange 'go up or down slightly depending on the previous line
End If
If rain < 470 Then 'if too much rain (lower is more chance of additional rain drops) the bump flow back up next line
rain = rain + 5
End If
'dry if rainfall rate is slow enough - 495 is not much rainfall. Below that it's too wet to expect any drying to happen
If rain > 495 Then
dry1 = dry1 + 1
If dry1 > 35 Then
dry1 = 0
For jx = 0 To scx
p1~& = Point(jx, scy - 1)
a99 = _Red32(p1~&)
b99 = _Green32(p1~&)
c99 = _Blue32(p1~&)
d99 = a99 + b99 + c99
If d99 > 0 Then
If a99 > 0 Then a99 = a99 - 1
If b99 > 0 Then b99 = b99 - 1
If c99 > 0 Then c99 = c99 - 1
c0(40) = _RGB(a99, b99, c99)
Line (jx, scy - 1)-(jx, scy), c0(40), BF
End If
Next jx
End If
End If
'no rain when over 500, bump flow value towards some rainfall
If rain > 510 Then
rain = rain - 7
End If
'generate rain droplets
dice1 = Int(Rnd * 500)
If dice1 > rain Then 'sometimes introduce a new droplet
flag2 = 0
'count up active droplets
ct = 0
For j = 1 To scx2
If dtx(j) > -1 Then
ct = ct + 1
End If
Next j
If ct < ctmax Then 'if not maxxed out, a new droplet is born
dx = Int(Rnd * scx2)
If dtx(dx) = -1 Then 'only in an available position
dtx(dx) = dx * res
dty(dx) = 0
End If
End If
End If
'droplets moving down until splash
For j = 1 To scx2
If dtx(j) > -1 Then
dty(j) = dty(j) + 1
If dty(j) < scy Then
Line (dtx(j), dty(j) - 4 * res)-(dtx(j) + res, dty(j) - 4 * res + res), c0(0), BF
Line (dtx(j), dty(j) - 0)-(dtx(j) + res, dty(j) - 0 + res), c0(7), BF
Line (dtx(j), dty(j) + 10 * res)-(dtx(j) + res, dty(j) + 10 * res + res), c0(6), BF
Line (dtx(j), dty(j) + 16 * res)-(dtx(j) + res, dty(j) + 16 * res + res), c0(5), BF
Line (dtx(j), dty(j) + 22 * res)-(dtx(j) + res, dty(j) + 22 * res + res), c0(4), BF
Line (dtx(j), dty(j) + 28 * res)-(dtx(j) + res, dty(j) + 28 * res + res), c0(3), BF
Line (dtx(j), dty(j) + 30 * res)-(dtx(j) + res, dty(j) + 30 * res + res), c0(2), BF
End If
If dty(j) = scy - 9 Then
Circle (dtx(j), scy + 2), 2, c0(3)
Circle (dtx(j) - 3, scy - 5), 1, c0(3)
Circle (dtx(j) + 3, scy - 5), 1, c0(3)
End If
If dty(j) = scy - 8 Then
Circle (dtx(j), scy + 2), 3, c0(4)
End If
If dty(j) = scy - 6 Then
Circle (dtx(j) - 5, scy - 8), 1, c0(3)
Circle (dtx(j) + 5, scy - 8), 1, c0(3)
End If
If dty(j) = scy - 2 Then
Circle (dtx(j), scy + 2), 4, c0(5)
End If
If dty(j) = scy - 1 Then
Circle (dtx(j), scy + 2), 5, c0(6)
End If
If dty(j) >= scy + 10 Then
Circle (dtx(j) - 3, scy - 5), 1, c0(0)
Circle (dtx(j) + 3, scy - 5), 1, c0(0)
End If
If dty(j) >= scy + 20 Then
Line (dtx(j) - 2, scy - 5)-(dtx(j) + 2, scy), c0(2), BF
End If
If dty(j) >= scy + 30 Then
Line (dtx(j) - 4, scy - 3)-(dtx(j) + 4, scy), c0(2), BF
End If
If dty(j) >= scy + 45 Then
Line (dtx(j) - 7, scy - 2)-(dtx(j) + 7, scy), c0(2), BF
End If
If dty(j) >= scy + 60 Then
Circle (dtx(j) - 5, scy - 8), 1, c0(0)
Circle (dtx(j) + 5, scy - 8), 1, c0(0)
Line (dtx(j) - 12, scy - 8)-(dtx(j) + 12, scy - 1), c0(0), BF
Line (dtx(j) - 12, scy - 1)-(dtx(j) + 12, scy), c0(2), BF
dtx(j) = -1 'expired
End If
End If
Next j
'======================================================
'adjust display speed using "w" and "s" keys
keypress$ = InKey$
If keypress$ = Chr$(115) Then dv = dv + 2
If keypress$ = Chr$(119) Then dv = dv - 2
If dv > 200 Then dv = 200
If dv < 2 Then dv = 2
'fancy indicator for display speed
'======================================================
'Locate 1, 1
'Print Using "#######"; dv
'Print "Speed"
'Line (69, 1)-(270, 10), c0(2), BF
'Line (70, 2)-(269, 9), c0(0), BF
'Line (69, 1)-(271 - dv, 10), c0(2), BF
'======================================================
For del1 = 1 To dv * 10000
Next del1
Loop Until flag > 0
End
|
|
|
|
| Primitive Radial Flagellum Cells |
|
Posted by: James D Jarvis - 08-22-2022, 12:46 AM - Forum: Programs
- Replies (2)
|
 |
More fun with the DRAW command. Pretty simple Radial Flagellum Cells moving about, sometimes bumping each other about. It'll keep on running until you hit the escape key.
Code: (Select All) ' radial flagellum cells animation
' By James D. Jarvis
' a simple simulation of animated cells
'they will bounce off the sides and wrestle with shove and pull each other now and again
' press esc to quit
xmax = 1100
ymax = 600
Screen _NewImage(xmax, ymax, 32)
_Title "Radial Flagellum"
Randomize Timer
ncells = 16+(rnd*16) 'you could also make this a fixed number, don't go too high this seems to bog down with too many cells
Dim Shared X(ncells), Y(ncells), r(ncells), xv(ncells), yv(ncells), kkr(ncells), kkg(ncells), kkb(ncells), a(ncells)
Dim Shared rt(ncells)
'build the cells
For c = 1 To ncells
X(c) = Int(2 + Rnd * (xmax - 60) / 28) * 30
Y(c) = Int(2 + Rnd * (ymax - 60) / 28) * 30
r(c) = 20 + Int(Rnd * 60)
xv(c) = Int(2 - Rnd * 4)
yv(c) = Int(2 - Rnd * 4)
kkr(c) = 150 + Int(Rnd * 100)
kkg(c) = 150 + Int(Rnd * 100)
kkb(c) = 150 + Int(Rnd * 100)
a(c) = 8 + Int(Rnd * 16)
rt(c) = Int(Rnd * 4) - Int(Rnd * 4)
Next c
'animate the cells
Do
_Limit 60
Cls
For c = 1 To ncells
For n = r(c) To Int(r(c) * .4) Step -2
draw_microbe X(c) + Sin(n / 4), Y(c) + Cos(n / 4), n + Int(Rnd * 4), kkr(c) - n * 2, kkg(c) - n * 2, kkb(c) - n * 2, a(c), c
Next
X(c) = X(c) + xv(c)
Y(c) = Y(c) + yv(c)
If X(c) < r(c) Then xv(c) = xv(c) * -1
If Y(c) < r(c) Then yv(c) = yv(c) * -1
If X(c) > xmax - r(c) Then xv(c) = xv(c) * -1
If Y(c) > ymax - r(c) Then yv(c) = yv(c) * -1
For c2 = 1 To ncells
If c2 <> c Then
If Int((X(c) + r(c)) / 40) = Int((X(c2) + r(c2)) / 40) And Int((Y(c) + r(c)) / 40) = Int((Y(c2) + r(c2)) / 40) Then
xv(c) = xv(c) * -1
yv(c) = yv(c) * -1
xv(c2) = xv(c2) * -1 + Rnd * .2 - Rnd * .2
yv(c2) = yv(c2) * -1 + Rnd * .2 - Rnd * .2
End If
End If
Next c2
rt(c) = rt(c) - (Rnd * 3) + (Rnd * 3)
Next
_Display
k$ = InKey$
Loop Until k$ = Chr$(27)
Sub draw_microbe (x, y, r, kR, kG, kB, arm, c)
'draw a crude radial microbe with flagellum
Draw "C" + Str$(_RGB32(kR, kG, kB))
Draw "bm" + Str$(x) + "," + Str$(y)
rv = Rnd * .2
For ang = 0 + rt(c) To 360 + rt(c) Step Int(360 / arm) + rv
wiggle$ = " r" + Str$((r + Int(Rnd * 3)) * .33) + " e" + Str$(1 + Int(Rnd * r(c) / 6))
wiggle$ = wiggle$ + " r" + Str$((r + Int(Rnd * 3)) * .33) + " e" + Str$(1 + Int(Rnd * r(c) / 6))
wiggle$ = wiggle$ + " r" + Str$((r + Int(Rnd * 3)) * .33)
Draw "ta" + Str$(ang) + wiggle$ + "bm" + Str$(x) + "," + Str$(y)
' Draw "ta" + Str$(ang) + " r" + Str$(r + Int(Rnd * 3)) + " u" + Str$(1 + Int(Rnd * 3)) + "m" + Str$(x) + "," + Str$(y)
Next ang
End Sub
|
|
|
|
| My Best Globe So Far |
|
Posted by: SierraKen - 08-21-2022, 12:15 AM - Forum: Programs
- Replies (6)
|
 |
This isn't animated, but by trial and error and a bit of experience, I made this PSET globe.
![[Image: Globe-by-Sierra-Ken.jpg]](https://i.ibb.co/HFztf1Y/Globe-by-Sierra-Ken.jpg)
Code: (Select All) _Title "Globe by SierraKen"
Screen _NewImage(800, 600, 32)
start:
t = 100 * (2 * _Pi)
cc = 50
w = 10
cc3 = 50
_Limit 20
While _MouseInput: Wend
If t < 0 Then GoTo start:
For l = -100 To 100 Step .025
cc3 = cc3 + .1
If cc3 > 255 Then cc3 = 50
x = (Sin(t) * 100) * (_Pi / 2) + 400
y = (Cos(t) * l) * (_Pi / 2) + 200
t = t - (.25 + w / 10)
PSet (x, y), _RGB32(cc3, cc3, 100 + cc3)
Next l
For l = -100 To 100 Step .025
cc = cc + .1
If cc > 255 Then cc = 50
x = (Sin(t) * l) * (_Pi / 2) + 400
y = (Cos(t) * 100) * (_Pi / 2) + 200
t = t - (.25 + w / 10)
PSet (x, y), _RGB32(cc, cc, 100 + cc)
Next l
t = t - .025
cc2 = 100
For sz = .1 To 100 Step .25
cc2 = cc2 - .25
Circle (400, 450), sz, _RGB32(100 + cc2, 100 + cc2, cc2), , , .5
Next sz
Line (400, 200)-(400, 450), _RGB32(255, 255, 255)
Do: Loop Until InKey$ = Chr$(27)
|
|
|
|
| Anemometer Wind Gauge |
|
Posted by: SierraKen - 08-20-2022, 06:28 PM - Forum: Programs
- Replies (3)
|
|
Today I decided to work more with 3D animation. 
Code: (Select All) _Title "Anemometer Wind Gauge by SierraKen"
Screen _NewImage(800, 600, 32)
t = 900
t2 = 1350
t3 = 1800
cc = 200
Do
_Limit 30
If t < 90 Then t = 900
If t2 < 135 Then t2 = 1350
If t3 < 180 Then t3 = 1800
x = (Sin(t) * 20) * (_Pi * 2) + 400
y = (Cos(t) * 10) * (_Pi / 2) + 200
r = (Cos(t) * 180) / _Pi / 1.5 + 50
t = t - .25
x2 = (Sin(t2) * 20) * (_Pi * 2) + 400
y2 = (Cos(t2) * 10) * (_Pi / 2) + 200
r2 = (Cos(t2) * 180) / _Pi / 1.5 + 50
t2 = t2 - .25
x3 = (Sin(t3) * 20) * (_Pi * 2) + 400
y3 = (Cos(t3) * 10) * (_Pi / 2) + 200
r3 = (Cos(t3) * 180) / _Pi / 1.5 + 50
t3 = t3 - .25
For S = .25 To r Step .1
cc = cc - .25
Circle (x, y), S, _RGB32(cc, cc, 100 + cc)
Next S
cc = 200
For S = .25 To r2 Step .1
cc = cc - .25
Circle (x2, y2), S, _RGB32(cc, 100 + cc, cc)
Next S
cc = 200
For S = .25 To r3 Step .1
cc = cc - .25
Circle (x3, y3), S, _RGB32(100 + cc, cc, cc)
Next S
cc = 200
Line (400, 200)-(x, y), _RGB32(255, 255, 255)
Line (400, 200)-(x2, y2), _RGB32(255, 255, 255)
Line (400, 200)-(x3, y3), _RGB32(255, 255, 255)
cc2 = 100
For sz = .1 To 100 Step .25
cc2 = cc2 - .25
Circle (400, 450), sz, _RGB32(100 + cc2, 100 + cc2, cc2), , , .5
Next sz
Line (400, 200)-(400, 450), _RGB32(255, 255, 255)
_Display
Cls
Loop
|
|
|
|
| Converting a MIDI file to text (csv, tab-delimited, etc.) and back again? |
|
Posted by: madscijr - 08-19-2022, 10:54 PM - Forum: General Discussion
- Replies (4)
|
 |
I could see these being a couple useful routines, and I even had (have? somewhere?) a couple ancient DOS EXEs that do it, but no source code and they may not work under modern Windows. If anyone has done this in QuickBasic or VB or a non-OO language like C, and would share your code, or even any experience with this, I would be willing to give it the old college try! :-D
|
|
|
|
| String Math (Add and Subtract) |
|
Posted by: SMcNeill - 08-19-2022, 06:25 PM - Forum: SMcNeill
- No Replies
|
 |
Code: (Select All) Screen _NewImage(1280, 720, 32)
a$ = "-10000000000000000000123.256"
b$ = " 60000000000000000000000.111"
Test a$, b$
a$ = " 100000000000000000000000000"
b$ = "-000000000000000000000000001.1"
Test a$, b$
a$ = "24123538548354853499345235498325489235982355952936529659265982635982398569.56466456"
b$ = "3.1"
Test a$, b$
Sub Test (a$, b$)
Print "==========================================================================="
Print a$
Print b$
Print "STEVE+:"; StringAdd(a$, b$)
Print "BTEN +:"; BTen$(a$, "+", b$)
Print "STEVE-:"; StringSubtract(a$, b$)
Print "BTEN -:"; BTen$(a$, "-", b$)
Print "==========================================================================="
Sleep
End Sub
Function StringAdd$ (tempa$, tempb$)
a$ = tempa$: b$ = tempb$ 'don't alter our original numbers
Dim As _Unsigned _Integer64 a, b, c, carryover 'to hold our values
'first fix the numbers to notmalize their lengths
FixNumbers a$, b$
'find the signs and strip them off
If Left$(a$, 1) = "-" Then sa$ = "-": a$ = Mid$(a$, 2) Else sa$ = " "
If Left$(b$, 1) = "-" Then sb$ = "-": b$ = Mid$(b$, 2) Else sb$ = " "
'find the decimal position
dp = InStr(a$, ".")
If dp > 0 Then 'remove the decimal place from our numbers. We can put it back later, in its proper position
righta$ = Mid$(a$, dp + 1)
rightb$ = Mid$(b$, dp + 1)
a$ = Left$(a$, dp - 1) + righta$
b$ = Left$(b$, dp - 1) + rightb$
End If
'our strings are now nothing but numbers with no signs and no decimals to deal with. Let's start adding!
'are we adding or really subtracting?
If sa$ <> sb$ Then 'we're subtracting the two values if the signs aren't the same.
Select Case a$
Case Is < b$: s$ = sb$: Swap a$, b$ 'our sign is going to be determiined by b$
Case Is = b$ 'if the two values are the same and are subtracting, our result is zero!
StringAdd$ = "0" 'How easy was that?
Exit Function
Case Else: s$ = sa$ 'our sign is determined by a$
End Select
Do
lb = Len(b$)
a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)
b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)
If borrow Then b = b + 1~&& 'in case we had to borrow a digit for the last subtraction
If a < b Then
If lb < 18 Then a = a + 10 ^ lb Else a = a + 10 ^ 18
borrow = -1
Else
borrow = 0
End If
c = a - b
temp$ = _Trim$(Str$(c))
answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$
Loop Until Len(a$) = 0
'remove leading 0's
Do Until Left$(answer$, 1) <> "0"
answer$ = Mid$(answer$, 2)
Loop
'remember to add in the decimal place before finished
dp = Len(righta$)
If dp > 0 Then
answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)
End If
StringAdd$ = s$ + answer$
Exit Function
End If
Do
a1$ = Right$(a$, 18)
b1$ = Right$(b$, 18)
a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)
b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)
c = a + b + carryover
temp$ = _Trim$(Str$(c))
If Len(temp$) > 18 Then 'see if we have an answer that is more than 18 digits
temp$ = Right$(temp$, 18) 'keep 18 digits
carryover = 1 'store one for carry over
Else
carryover = 0 'no carryover
End If
answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$
Loop Until Len(a$) = 0
If carryover Then answer$ = "1" + answer$
'remember to add in the decimal place before finished
dp = Len(righta$)
If dp > 0 Then
answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)
End If
'remove leading 0's
Do Until Left$(answer$, 1) <> "0"
answer$ = Mid$(answer$, 2)
Loop
StringAdd$ = sa$ + answer$
End Function
Function StringSubtract$ (tempa$, tempb$)
a$ = tempa$: b$ = tempb$
FixNumbers a$, b$
If Left$(b$, 1) = "-" Then b$ = Mid$(b$, 2) Else b$ = "-" + b$
StringSubtract$ = StringAdd$(a$, b$)
End Function
Sub FixNumbers (a$, b$)
'first remove scientific notation and spaces from both
a$ = _Trim$(N2S$(a$)): b$ = _Trim$(N2S$(b$))
'then find the decimal position for both and normalize the expressions
d1 = InStr(a$, "."): d2 = InStr(b$, ".")
If d1 <> 0 Then 'break down the left and right side of the decimal point for ease of processing (this is a$)
lefta$ = Left$(a$, d1 - 1)
righta$ = Mid$(a$, d1)
Else
lefta$ = a$
End If
If d2 <> 0 Then 'break down the left and right side of the decimal point for ease of processing (this is b$)
leftb$ = Left$(b$, d2 - 1)
rightb$ = Mid$(b$, d2)
Else
leftb$ = b$
End If
'normalize the right side of our expressions
l1 = Len(righta$): l2 = Len(rightb$)
If l1 < l2 Then
addzero = l2 - l1
If l1 = 0 Then righta$ = ".": addzero = addzero - 1
righta$ = righta$ + String$(addzero, "0")
ElseIf l1 > l2 Then
addzero = l1 - l2
'If l2 = 0 Then rightb$ = ".": addzero = addzero - 1
rightb$ = rightb$ + String$(addzero, "0")
End If
'strip off any plus/minus signs from the two numbers.
If Left$(lefta$, 1) = "-" Then signa$ = "-": lefta$ = Mid$(lefta$, 2)
If Left$(leftb$, 1) = "-" Then signb$ = "-": leftb$ = Mid$(leftb$, 2)
If Left$(lefta$, 1) = "+" Then signa$ = "": lefta$ = Mid$(lefta$, 2)
If Left$(leftb$, 1) = "+" Then signb$ = "": leftb$ = Mid$(leftb$, 2)
'normalize the left side of our expressions
l1 = Len(lefta$): l2 = Len(leftb$)
If l1 < l2 Then
addzero = l2 - l1
lefta$ = String$(addzero, "0") + lefta$
ElseIf l1 > l2 Then
addzero = l1 - l2
leftb$ = String$(addzero, "0") + leftb$
End If
'and then put it all together
a$ = signa$ + lefta$ + righta$
b$ = signb$ + leftb$ + rightb$
End Sub
Function N2S$ (exp$) 'scientific Notation to String
t$ = LTrim$(RTrim$(exp$))
If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)
dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
ep = InStr(t$, "E+"): em = InStr(t$, "E-")
check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
If check1 < 1 Or check1 > 1 Then N2S = exp$: Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
Select Case l 'l now tells us where the SN starts at.
Case Is < dp: l = dp
Case Is < dm: l = dm
Case Is < ep: l = ep
Case Is < em: l = em
End Select
l$ = Left$(t$, l - 1) 'The left of the SN
r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
If InStr(l$, ".") Then 'Location of the decimal, if any
If r&& > 0 Then
r&& = r&& - Len(l$) + 2
Else
r&& = r&& + 1
End If
l$ = Left$(l$, 1) + Mid$(l$, 3)
End If
Select Case r&&
Case 0 'what the heck? We solved it already?
'l$ = l$
Case Is < 0
For i = 1 To -r&&
l$ = "0" + l$
Next
l$ = "0." + l$
Case Else
For i = 1 To r&&
l$ = l$ + "0"
Next
End Select
N2S$ = sign$ + l$
End Function
Function DWD$ (exp$) 'Deal With Duplicates
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
t$ = exp$
Do
bad = 0
Do
l = InStr(t$, "++")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "+-")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "-+")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "--")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Loop Until Not bad
DWD$ = t$
End Function
Function BTen$ (InTop As String, Op As String, InBot As String)
Rem $DYNAMIC
InTop = LTrim$(RTrim$(InTop))
InBot = LTrim$(RTrim$(InBot))
l = InStr(InTop, "-")
If l = 0 Then l = InStr(InTop, "+")
If l = 0 Then InTop = "+" + InTop
l = InStr(InBot, "-")
If l = 0 Then l = InStr(InBot, "+")
If l = 0 Then InBot = "+" + InBot
l = InStr(InTop, ".")
If l = 0 Then InTop = InTop + "."
l = InStr(InBot, ".")
If l = 0 Then InBot = InBot + "."
If Op$ = "-" Then
Op$ = "+"
If Mid$(InBot, 1, 1) = "-" Then Mid$(InBot, 1, 1) = "+" Else Mid$(InBot, 1, 1) = "-"
End If
TDP& = Check&(10, InTop$)
BDP& = Check&(10, InBot$)
If TDP& < 0 Or BDP& < 0 Then Exit Function
TSign% = Check&(11, InTop$)
BSign% = Check&(11, InBot$)
' Calculate Array Size
If Op$ = Chr$(43) Or Op$ = Chr$(45) Then
' "+" (Add) OR "-" (Subtract)
Temp& = 9
ElseIf Op$ = Chr$(42) Or Op$ = Chr$(50) Then
' "*" (Multiply) OR "2" (SQRT Multiply)
Temp& = 7
Else
Exit Function
End If
' LSA (Left Side of Array)
LSA& = TDP& - 2
TLS& = LSA& \ Temp&
If LSA& Mod Temp& > 0 Then
TLS& = TLS& + 1
Do While (TLPad& + LSA&) Mod Temp& > 0
TLPad& = TLPad& + 1
Loop
End If
LSA& = BDP& - 2
BLS& = LSA& \ Temp&
If LSA& Mod Temp& > 0 Then
BLS& = BLS& + 1
Do While (BLPad& + LSA&) Mod Temp& > 0
BLPad& = BLPad& + 1
Loop
End If
If TLS& >= BLS& Then LSA& = TLS& Else LSA& = BLS&
' RSA (Right Side of Array)
RSA& = Len(InTop$) - TDP&
TRS& = RSA& \ Temp&
If RSA& Mod Temp& > 0 Then
TRS& = TRS& + 1
Do While (TRPad& + RSA&) Mod Temp& > 0
TRPad& = TRPad& + 1
Loop
End If
RSA& = Len(InBot$) - BDP&
BRS& = RSA& \ Temp&
If RSA& Mod Temp& > 0 Then
BRS& = BRS& + 1
Do While (BRPad& + RSA&) Mod Temp& > 0
BRPad& = BRPad& + 1
Loop
End If
If TRS& >= BRS& Then RSA& = TRS& Else RSA& = BRS&
If Op$ = Chr$(43) Or Op$ = Chr$(45) Then
' "+" (Add) OR "-" (Subtract)
Dim Result(1 To (LSA& + RSA&)) As Long
If (Op$ = Chr$(43) And TSign% = BSign%) Or (Op$ = Chr$(45) And TSign% <> BSign%) Then
' Add Absolute Values and Return Top Sign
' Left Side
For I& = 1 To LSA&
' Top
If I& <= (LSA& - TLS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (1 + LSA& - TLS&) Then
Result(I&) = Val(Mid$(InTop$, 2, (9 - TLPad&)))
TDP& = 11 - TLPad&
Else
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
End If
' Bottom
If I& <= (LSA& - BLS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (1 + LSA& - BLS&) Then
Result(I&) = Result(I&) + Val(Mid$(InBot$, 2, (9 - BLPad&)))
BDP& = 11 - BLPad&
Else
Result(I&) = Result(I&) + Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
End If
Next I&
' Right Side
TDP& = TDP& + 1: BDP& = BDP& + 1
For I& = (LSA& + 1) To (LSA& + RSA&)
' Top
If I& > (LSA& + TRS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (LSA& + TRS&) Then
Result(I&) = (10 ^ TRPad&) * Val(Right$(InTop$, (9 - TRPad&)))
Else
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
End If
' Bottom
If I& > (LSA& + BRS&) Then
''' Result(I&) = Result(I&) + 0
ElseIf I& = (LSA& + BRS&) Then
Result(I&) = Result(I&) + (10 ^ BRPad&) * Val(Right$(InBot$, (9 - BRPad&)))
Else
Result(I&) = Result(I&) + Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
End If
Next I&
' Carry
For I& = (LSA& + RSA&) To 2 Step -1
If Result(I&) >= 1000000000 Then
Result(I& - 1) = Result(I& - 1) + 1
Result(I&) = Result(I&) - 1000000000
End If
Next I&
' Return Sign
If TSign% = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
Else
' Compare Absolute Values
If TDP& > BDP& Then
Compare& = 1
ElseIf TDP& < BDP& Then
Compare& = -1
Else
If Len(InTop$) > Len(InBot$) Then Compare& = Len(InBot$) Else Compare& = Len(InTop$)
For I& = 2 To Compare&
If Val(Mid$(InTop$, I&, 1)) > Val(Mid$(InBot$, I&, 1)) Then
Compare& = 1
Exit For
ElseIf Val(Mid$(InTop$, I&, 1)) < Val(Mid$(InBot$, I&, 1)) Then
Compare& = -1
Exit For
End If
Next I&
If Compare& > 1 Then
If Len(InTop$) > Len(InBot$) Then
Compare& = 1
ElseIf Len(InTop$) < Len(InBot$) Then
Compare& = -1
Else
Compare& = 0
End If
End If
End If
' Conditional Subtraction
If Compare& = 1 Then
' Subtract Bottom from Top and Return Top Sign
' Top
Result(1) = Val(Mid$(InTop$, 2, (9 - TLPad&)))
TDP& = 11 - TLPad&
For I& = 2 To LSA&
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
Next I&
TDP& = TDP& + 1
For I& = (LSA& + 1) To (LSA& + TRS& - 1)
Result(I&) = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& + 9
Next I&
Result(LSA& + TRS&) = 10& ^ TRPad& * Val(Right$(InTop$, (9 - TRPad&)))
' Bottom
BDP& = (Len(InBot$) - 17) + BRPad&
For I& = (LSA& + BRS&) To (1 + LSA& - BLS&) Step -1
If I& = LSA& Then BDP& = BDP& - 1
If I& = (LSA& + BRS&) Then
Temp& = (10& ^ BRPad&) * Val(Right$(InBot$, (9 - BRPad&)))
ElseIf I& = (1 + LSA& - BLS&) Then
Temp& = Val(Mid$(InBot$, 2, (9 - BLPad&)))
Else
Temp& = Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& - 9
End If
If Result(I&) < Temp& Then
' Borrow
For J& = (I& - 1) To 1 Step -1
If Result(J&) = 0 Then
Result(J&) = 999999999
Else
Result(J&) = Result(J&) - 1
Exit For
End If
Next J&
Result(I&) = Result(I&) + 1000000000
End If
Result(I&) = Result(I&) - Temp&
Next I&
' Return Sign
If TSign% = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
ElseIf Compare& = -1 Then
' Subtract Top from Bottom and Return Bottom Sign
' Bottom
Result(1) = Val(Mid$(InBot$, 2, (9 - BLPad&)))
BDP& = 11 - BLPad&
For I& = 2 To LSA&
Result(I&) = Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
Next I&
BDP& = BDP& + 1
For I& = (LSA& + 1) To (LSA& + BRS& - 1)
Result(I&) = Val(Mid$(InBot$, BDP&, 9))
BDP& = BDP& + 9
Next I&
Result(LSA& + BRS&) = 10& ^ BRPad& * Val(Right$(InBot$, (9 - BRPad&)))
' Top
TDP& = (Len(InTop$) - 17) + TRPad&
For I& = (LSA& + TRS&) To (1 + LSA& - TLS&) Step -1
If I& = LSA& Then TDP& = TDP& - 1
If I& = (LSA& + TRS&) Then
Temp& = (10& ^ TRPad&) * Val(Right$(InTop$, (9 - TRPad&)))
ElseIf I& = (1 + LSA& - TLS&) Then
Temp& = Val(Mid$(InTop$, 2, (9 - TLPad&)))
Else
Temp& = Val(Mid$(InTop$, TDP&, 9))
TDP& = TDP& - 9
End If
If Result(I&) < Temp& Then
' Borrow
For J& = (I& - 1) To 1 Step -1
If Result(J&) = 0 Then
Result(J&) = 999999999
Else
Result(J&) = Result(J&) - 1
Exit For
End If
Next J&
Result(I&) = Result(I&) + 1000000000
End If
Result(I&) = Result(I&) - Temp&
Next I&
' Build Return Sign
If BSign% = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
Else
' Result will always be 0
LSA& = 1: RSA& = 1
RetStr$ = Chr$(43)
End If
End If
' Generate Return String
RetStr$ = RetStr$ + LTrim$(Str$(Result(1)))
For I& = 2 To LSA&
RetStr$ = RetStr$ + Right$(String$(8, 48) + LTrim$(Str$(Result(I&))), 9)
Next I&
RetStr$ = RetStr$ + Chr$(46)
For I& = (LSA& + 1) To (LSA& + RSA&)
RetStr$ = RetStr$ + Right$(String$(8, 48) + LTrim$(Str$(Result(I&))), 9)
Next I&
Erase Result
ElseIf Op$ = Chr$(42) Then
' * (Multiply)
Dim TArray(1 To (LSA& + RSA&)) As Long
Dim BArray(1 To (LSA& + RSA&)) As Long
Dim ResDBL(0 To (LSA& + RSA&)) As Double
' Push String Data Into Array
For I& = 1 To LSA&
If I& <= (LSA& - TLS&) Then
''' TArray(I&) = TArray(I&) + 0
ElseIf I& = (1 + LSA& - TLS&) Then
TArray(I&) = Val(Mid$(InTop$, 2, (7 - TLPad&)))
TDP& = 9 - TLPad&
Else
TArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
If I& <= (LSA& - BLS&) Then
''' BArray(I&) = BArray(I&) + 0
ElseIf I& = (1 + LSA& - BLS&) Then
BArray(I&) = Val(Mid$(InBot$, 2, (7 - BLPad&)))
BDP& = 9 - BLPad&
Else
BArray(I&) = Val(Mid$(InBot$, BDP&, 7))
BDP& = BDP& + 7
End If
Next I&
TDP& = TDP& + 1: BDP& = BDP& + 1
For I& = (LSA& + 1) To (LSA& + RSA&)
If I& > (LSA& + TRS&) Then
''' TArray(I&) = TArray(I&) + 0
ElseIf I& = (LSA& + TRS&) Then
TArray(I&) = 10 ^ TRPad& * Val(Right$(InTop$, (7 - TRPad&)))
Else
TArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
If I& > (LSA& + BRS&) Then
''' BArray(I&) = BArray(I&) + 0
ElseIf I& = (LSA& + BRS&) Then
BArray(I&) = 10 ^ BRPad& * Val(Right$(InBot$, (7 - BRPad&)))
Else
BArray(I&) = Val(Mid$(InBot$, BDP&, 7))
BDP& = BDP& + 7
End If
Next I&
' Multiply from Arrays to Array
For I& = (LSA& + TRS&) To (1 + LSA& - TLS&) Step -1
For J& = (LSA& + BRS&) To (1 + LSA& - BLS&) Step -1
Temp# = 1# * TArray(I&) * BArray(J&)
If (I& + J&) Mod 2 = 0 Then
TL& = Int(Temp# / 10000000)
TR& = Temp# - 10000000# * TL&
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + 10000000# * TR&
Else
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + Temp#
End If
If ResDBL((I& + J&) \ 2) >= 100000000000000# Then
Temp# = ResDBL((I& + J&) \ 2)
TL& = Int(Temp# / 100000000000000#)
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = Temp# - 100000000000000# * TL&
End If
Next J&
Next I&
Erase TArray, BArray
' Generate Return String
If (TSign% * BSign%) = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
RetStr$ = RetStr$ + LTrim$(Str$(ResDBL(0)))
For I& = 1 To (LSA&)
RetStr$ = RetStr$ + Right$(String$(13, 48) + LTrim$(Str$(ResDBL(I&))), 14)
Next I&
RetStr$ = Left$(RetStr$, Len(RetStr$) - 7) + Chr$(46) + Right$(RetStr$, 7)
For I& = (LSA& + 1) To (LSA& + RSA&)
RetStr$ = RetStr$ + Right$(String$(13, 48) + LTrim$(Str$(ResDBL(I&))), 14)
Next I&
Erase ResDBL
ElseIf Op$ = Chr$(50) Then
' 2 (SQRT Multiply)
Dim IArray(1 To (LSA& + RSA&)) As Long
Dim ResDBL(0 To (LSA& + RSA&)) As Double
' Push String Data Into Array
For I& = 1 To LSA&
If I& <= (LSA& - TLS&) Then
''' IArray(I&) = IArray(I&) + 0
ElseIf I& = (1 + LSA& - TLS&) Then
IArray(I&) = Val(Mid$(InTop$, 2, (7 - TLPad&)))
TDP& = 9 - TLPad&
Else
IArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
Next I&
TDP& = TDP& + 1
For I& = (LSA& + 1) To (LSA& + RSA&)
If I& > (LSA& + TRS&) Then
''' IArray(I&) = IArray(I&) + 0
ElseIf I& = (LSA& + TRS&) Then
IArray(I&) = 10 ^ TRPad& * Val(Right$(InTop$, (7 - TRPad&)))
Else
IArray(I&) = Val(Mid$(InTop$, TDP&, 7))
TDP& = TDP& + 7
End If
Next I&
' SQRT Multiply from Array to Array
For I& = (LSA& + TRS&) To 1 Step -1
For J& = I& To 1 Step -1
Temp# = 1# * IArray(I&) * IArray(J&)
If I& <> J& Then Temp# = Temp# * 2
If (I& + J&) Mod 2 = 0 Then
TL& = Int(Temp# / 10000000)
TR& = Temp# - 10000000# * TL&
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + 10000000# * TR&
Else
ResDBL((I& + J&) \ 2) = ResDBL((I& + J&) \ 2) + Temp#
End If
If ResDBL((I& + J&) \ 2) >= 100000000000000# Then
Temp# = ResDBL((I& + J&) \ 2)
TL& = Int(Temp# / 100000000000000#)
ResDBL(((I& + J&) \ 2) - 1) = ResDBL(((I& + J&) \ 2) - 1) + TL&
ResDBL((I& + J&) \ 2) = Temp# - 100000000000000# * TL&
End If
Next J&
Next I&
Erase IArray
' Generate Return String
If (TSign% * BSign%) = 1 Then RetStr$ = Chr$(43) Else RetStr$ = Chr$(45)
RetStr$ = RetStr$ + LTrim$(Str$(ResDBL(0)))
For I& = 1 To (LSA&)
RetStr$ = RetStr$ + Right$(String$(13, 48) + LTrim$(Str$(ResDBL(I&))), 14)
Next I&
RetStr$ = Left$(RetStr$, Len(RetStr$) - 7) + Chr$(46) + Right$(RetStr$, 7)
' Don't usually want the full right side for this, just enough to check the
' actual result against the expected result, which is probably an integer.
' Uncomment the three lines below when trying to find an oddball square root.
'FOR I& = (LSA& + 1) TO (LSA& + RSA&)
' RetStr$ = RetStr$ + RIGHT$(STRING$(13, 48) + LTRIM$(STR$(ResDBL(I&))), 14)
'NEXT I&
Erase ResDBL
End If
' Trim Leading and Trailing Zeroes
Do While Mid$(RetStr$, 2, 1) = Chr$(48) And Mid$(RetStr$, 3, 1) <> Chr$(46)
RetStr$ = Left$(RetStr$, 1) + Right$(RetStr$, Len(RetStr$) - 2)
Loop
Do While Right$(RetStr$, 1) = Chr$(48) And Right$(RetStr$, 2) <> Chr$(46) + Chr$(48)
RetStr$ = Left$(RetStr$, Len(RetStr$) - 1)
Loop
If Mid$(RetStr$, 1, 1) = "+" Then Mid$(RetStr$, 1, 1) = " "
Do
r$ = Right$(RetStr$, 1)
If r$ = "0" Then RetStr$ = Left$(RetStr$, Len(RetStr$) - 1)
Loop Until r$ <> "0"
r$ = Right$(RetStr$, 1)
If r$ = "." Then RetStr$ = Left$(RetStr$, Len(RetStr$) - 1)
BTen$ = RetStr$
End Function
Rem $STATIC
' ---------------------------------------------------------------------------
' FUNCTION Check& (Op&, InString$) Multi-Purpose String Tester
' ---------------------------------------------------------------------------
'
' * Op& = Type of string to expect and/or operation to perform
'
' { 00A } = (10) Test Base-10-Format String ( *!* ALTERS InString$ *!* )
' { 00B } = (11) Read Sign ("+", "-", or CHR$(241))
'
' Unlisted values are not used and will return [ Check& = 0 - Op& ].
' Different Op& values produce various return values.
' Refer to the in-code comments for details.
'
' ---------------------------------------------------------------------------
' FUNCTION Check& (Op&, InString$) Multi-Purpose String Tester
' ---------------------------------------------------------------------------
Function Check& (Op As Long, InString As String)
Rem $DYNAMIC
RetVal& = Len(InString$)
Select Case Op&
Case 10
' {00A} Test String for Base-10-Format ( *!* ALTERS InString$ *!* )
' Returns:
' {& > 0} = DP offset; {& < 0} = FAILED at negative offset
'
' After testing passes, the string is trimmed
' of nonessential leading and trailing zeroes.
If RetVal& = 0 Then
RetVal& = -1
Else
Select Case Asc(Left$(InString$, 1))
Case 43, 45 ' "+", "-"
For I& = 2 To RetVal&
Select Case Asc(Mid$(InString$, I&, 1))
Case 46 ' "."
If DPC% > 0 Then
RetVal& = 0 - I&
Exit For
Else
DPC% = DPC% + 1
RetVal& = I&
End If
Case 48 To 57
' keep going
Case Else
RetVal& = 0 - I&
Exit For
End Select
Next I&
Case Else
RetVal& = -1
End Select
If DPC% = 0 And RetVal& > 0 Then
RetVal& = 0 - RetVal&
ElseIf RetVal& = 2 Then
InString$ = Left$(InString$, 1) + Chr$(48) + Right$(InString$, Len(InString$) - 1)
RetVal& = RetVal& + 1
End If
If RetVal& = Len(InString$) Then InString$ = InString$ + Chr$(48)
Do While Asc(Right$(InString$, 1)) = 48 And RetVal& < (Len(InString$) - 1)
InString$ = Left$(InString$, Len(InString$) - 1)
Loop
Do While Asc(Mid$(InString$, 2, 1)) = 48 And RetVal& > 3
InString$ = Left$(InString$, 1) + Right$(InString$, Len(InString$) - 2)
RetVal& = RetVal& - 1
Loop
End If
Case 11
' {00B} Read Sign ("+", "-", or CHR$(241))
' Returns:
' Explicit: +1 = Positive; -1 = Negative; 0 = Unsigned;
' Implied: +64 = Positive; -64 = NULL String
If RetVal& = 0 Then RetVal& = -64
For I& = 1 To RetVal&
Select Case Asc(Mid$(InString$, I&, 1))
Case 32
RetVal& = 64
' keep going
Case 43
RetVal& = 1
Exit For
Case 45
RetVal& = -1
Exit For
Case 241
RetVal& = 0
Exit For
Case Else
RetVal& = 64
Exit For
End Select
Next I&
Case Else
RetVal& = 0 - Op&
End Select
Check& = RetVal&
End Function
Code to plug in and use for string math. So far, I've only coded these for addition or subtraction, though the older BTEN$ also handles multiplication and SQRT. I figured I'd toss these up here as it seems nearly every programmer ends up writing a sting math routine at some point in their coding career, and these should be easy enough to plug into any other program and use as a comparison test to make certain that results match.
Of course, if results don't match, and the issue is somehow with my code here, feel free to mention it to me and I'll try and dig into the problem and sort it out. There's a lot of little tweaks which can toss string math off, so I wouldn't swear everything here is 100% bug-free, but it's got 2 different routines to compare against, if you need it. AFAIK, things work without issues, but I wouldn't swear to anything. After all, @Pete found a glitch earlier where my integer64 variables were trying to do floating point math, and I *never* would've expected that ! (Especially just to add 1 for carryover!!)
I reserve the right to always hide glitches somewhere in the code for... umm.... for... for learning experience! Yeah! There might be some in there for the learning experience!
|
|
|
|
| palindrome with numbers |
|
Posted by: madscijr - 08-19-2022, 03:51 PM - Forum: Programs
- Replies (7)
|
|
Here's a neat little math factoid a coworker shared with us,
if you multiply 111,111,111 times 111,111,111
the answer is 12345678987654321 (reads the same backwards as forwards).
I got it working in QB64 with _INTEGER64, but a plain Excel formula does not yield the right answer!
Code: (Select All) Dim n1&&, n2&&, n3&&, n4&&
n1&& = 111111111
n2&& = n1&& * n1&&
Print " " + _Trim$(Str$(n1&&))
Print " x " + _Trim$(Str$(n1&&))
Print " -----------------"
Print " = " + _Trim$(Str$(n2&&))
Print
n3&& = 12345678987654321
n4&& = Sqr(n3&&)
Print "Sqr(" + _Trim$(Str$(n3&&)) + ")"
Print " = " + _Trim$(Str$(n4&&))
![[Image: math-tidbit-1.png]](https://i.ibb.co/3mfGy78/math-tidbit-1.png)
|
|
|
|
|
