MathToString$(...)

This code has been declared by its author to be Public Domain code.

MathToString$(...) by ShadowTurtle

2003

New in 1.5: More Operators

have fun :)

Print MathToString("3")
Print MathToString("2/(3+2)")
Print MathToString("5>1 And 5<100")

Function MathToString$(TheMath$, unit = 0, divnow = 0)
  Local MyParam$ = "*/^+-=<>&|%@", MyNumbs$ = "0123456789.", MyDivParam$ = "*/^"
  Local Ziffer$, ScanPos, MathAnswer#, MathArt$, MathPower#, OldMathPower#
  Local Scan, ScanNumber$, OldScanNumber$, MathScan$, MyScanText$

  Local bscan, bscannow, bscanhave, ScanPosA, ScanPosB

  Local deScan, deMathScan$, deMath

  Local debsScan

  TheMath$ = Lower(TheMath$)
  TheMath$ = Replace(TheMath$, "and", "&")
  TheMath$ = Replace(TheMath$, "xor", "@")
  TheMath$ = Replace(TheMath$, "or", "|")
  TheMath$ = Replace(TheMath$, "mod", "%")

  MathScan$ = Replace(TheMath$, " ", "") : debsScan = 1

  While bscan < Len(MathScan$) 
    bscan = bscan + 1 
    If Mid$(MathScan$, bscan, 1) = "(" Then 
      ScanPosA = bscan : bscannow = 1 
      While bscannow 
       If Mid$(MathScan$, bscan, 1) = "(" Then bscanhave = bscanhave + 1 
       If Mid$(MathScan$, bscan, 1) = ")" Then bscanhave = bscanhave - 1 
       If bscanhave = 0 Then bscannow = 0 
       bscan = bscan + 1 
       If KeyDown(1) Then End 
      Wend 

      ScanPosB = bscan 

      MyScanText$ = Mid$(MathScan$, ScanPosA+1, ScanPosB - ScanPosA - 2)

      MyScanText$ = MathToString$(MyScanText$, unit + 1) 
      MathScan$ = Replace(MathScan$, Mid$(MathScan$, ScanPosA, ScanPosB - ScanPosA), MyScanText$)
      bscan = 0
    End If 

    If KeyDown(1) Then End 
  Wend 

  .NewMathScan

  deMathScan$ = MathScan$

  Scan = InMid$(MathScan$, MyParam$)
  If Scan Then
    ScanNumber$ = Mid$(MathScan$, 1, Scan-1)
    MathScan$ = Mid$(MathScan$, Scan)
    MathAnswer = val2(ScanNumber$)
  Else
    Return MathScan$
  End If

  deScan = 1

  While Not MathScan$ = ""
    uu$ = MathScan$

    MathArt$ = Mid$(MathScan$, 1, 1)
    MathScan$ = Mid$(MathScan$, 2)

    If Mid$(MathScan$,1,1) = "-" Then
      MathPower# = -1
      MathScan$ = Mid$(MathScan$, 2)
    Else
      MathPower# = 1
    End If

    Scan = InMid$(MathScan$, MyParam$)
    OldScanNumber$ = ScanNumber$
    OldMathPower# = MathPower#
    ScanNumber$ = Mid$(MathScan$, 1, Scan-1)

    MathScan$ = Mid$(MathScan$, Len(ScanNumber$)+1)

    If MathArt$ = "+" Then
       MathAnswer# = MathAnswer# + (val2(ScanNumber$)*MathPower#)
    ElseIf MathArt$ = "-" Then
       MathAnswer# = MathAnswer# - (val2(ScanNumber$)*MathPower#)
    ElseIf MathArt$ = "*" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) * (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "*-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "*" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "/" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) / (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "/-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "/" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "^" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) ^ (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "^-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "^" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "=" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) = (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "=-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "=" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "<" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) < (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "<-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "<" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = ">" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) > (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + ">-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + ">" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "&" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) And (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "&-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "&" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "|" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) Or (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "|-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "|" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "%" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) Mod (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "%-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "%" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    ElseIf MathArt$ = "@" Then
       MathAnswer# = (val2(OldScanNumber$)*OldMathPower#) Xor (val2(ScanNumber$)*MathPower#)
       If MathPower# = -1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "@-" + ScanNumber$, "-" + Str$(MathAnswer))
       ElseIf MathPower# = 1 Then
         MathScan$ = Replace(deMathScan$, OldScanNumber$ + "@" + ScanNumber$, Str$(MathAnswer))
       End If
       Goto NewMathScan
    Else
       Return "SYNTAX ERROR"
    End If
  Wend

  Return Str(MathAnswer)
End Function

Function InMid$(A$, B$) ; in benutzung
  Local C, Q, W
  C = 0
  For Q = 1 To Len(A$)
    For W = 1 To Len(B$)
      If (Mid$(A$, Q, 1) = Mid$(B$, W, 1)) And C = 0 Then C = Q : Exit
    Next
    If C>0 Then Exit
  Next
  Return C
End Function

Function val2#(sstring$)
Local temp#=0
Local decimal=0
Local sign=1
Local a
Local b
Local c
Local base=10
a=Instr(sstring$,"-",1)
If a Then negative=-1
b=Instr(sstring$,"&",a+1)
If b Then
  Select Mid$(sstring$,a+1,1)
  Case "B", "b"
    base=2
    a=b+1
  Case "O", "o"
    base=8
    a=b+1
  Case "H", "h"
    base=16
    a=b+1
  Default
    base=10
  End Select
End If
decimal=0
For b=a+1 To Len(sstring$)
  c=Asc(Mid(sstring$,b,1))
  Select c
  Case 44          ;","
    Goto skip
  Case 45          ;"-"
    sign=-sign
  Case 46          ;"."
    decimal=1
  Case 48,49,50,51,52,53,54,55,56,57   ;"0" To "9"
    temp#=temp*base+c-48
    If decimal Then decimal=decimal*base
  Case 65,66,67,68,69,60    ;"A" to "F"
    If base=16 Then
      temp#=temp#*base+c-55
      If decimal Then decimal=decimal*base
    Else
      Goto fini
    EndIf
  Case 97,98,99,100,101,102   ;"a" to "f"
    If base=16 Then
      temp#=temp#*base+c-87
      If decimal Then decimal=decimal*base
    Else
      Goto fini
    EndIf
  Default
    Goto fini
  End Select
.skip
Next
.fini
If decimal Then temp#=temp#/decimal

If negative = -1 Then
  Return -(temp#*sign)
Else
  Return temp#*sign
End If
End Function

Comments

ShadowTurtle

2015

i had think about writing a code lexer but here is the end. Helpfull for anyone?

virtlands

2015

I tested this code. So, in other words, it parses math "text", computes it, and returns the result as updated "text".

QUite interesting. I can imagine you took days on this.

ShadowTurtle

2015

weeks ;)

virtlands

2015

I just had a wild idea for a future project...

(A:) You can extend this concept of text computations to include various mathematical unicode characters,..., and therefore compute that text.

For example, you can parse (and compute) text that has subscripts, superscripts, fractions, etc.

SC Unipad (excellent unicode editor) :: http://www.unipad.org/main/

....Here's some Unicode code that I did (several years ago). I forgot what it does; you're welcome to use it.

UNICODE to UTF8 conversion Functions

;; Some important UNICODE to UTF8 conversion Functions:
;;


;;  You'll need to purchase your copy of FastText.DLL

Include "C:\Blitz3d Projects\FastText_unicode.BB"    

;; Global WhiteSquare_UTF8$ = Uni_to_UTF8$($1111)  ;; ??????

Type UTF8
     Field byte[4]
     Field s$
End Type 

UTF8sam.UTF8 = New UTF8   ;; UTF8 Sample

 Graphics 1024,480,32,2
 Local s$

 UniFont0=LoadFont("Tahoma",25)
 font0=LoadFont("arial.ttf",20)	
 SetFont UniFont0
	
 horiz = 60  ;; a horizontal placement	

 ;; This loop prints UTF8 (unicode) characters one-at-a-time. 
 ;; 	
 For u = $24E6 To $24FE
        Text horiz,40, Uni_To_UTF8(u)        
        horiz = horiz +20
 Next 	

 ;; This loop builds up a string first, and then prints them all at once
 ;;
 For u = $2730 To $274D
       s$ = s$ + uni_to_utf8(u)           
 Next      

 Text 60,70, s    


 WaitKey():End 


; This function converts a unicode value
; into a UTF8 byte string
;
Function Uni_to_UTF8$(u)
 Local b1,b2,b3,b4

 If (u < $80)    
     Return Chr$(u)    
 End If 

 If (u < $800)
     b1 = ((u Shr 6) And $1f) Or $c0
     b2 = (u And $3f) Or $80
     Return Chr$(b1)+Chr$(b2)   
 End If 

 If (u<$10000)
     b1 = ((u Shr 12) And $0f) Or $e0
     b2 = ((u Shr 6) And $3f) Or $80
     b3 = (u And $3f) Or $80
     Return Chr$(b1)+Chr$(b2)+Chr$(b3) 
 End If 

 If (u<$110000)
     b1 = ((u Shr 18) And $7) Or $f0
     b2 = ((u Shr 12) And $3f) Or $80
     b3 = ((u Shr 6) And $3f) Or $80
     b4 = (u And $3f) Or $80 
     Return Chr$(b1)+Chr$(b2)+Chr$(b3)+Chr$(b4)
 End If 

End Function 


;  creates a UTF8 type from a unicode input
;
Function Uni_to_UTF8t.UTF8(ut.UTF8,u) 
 Local b1,b2,b3,b4 

 If (u < $80)    
     Return SetUTF8(ut,u)  
 End If 

 If (u < $800)
     b1 = ((u Shr 6) And $1f) Or $c0
     b2 = (u And $3f) Or $80
     Return SetUTF8(ut,b1,b2)     
 End If 

 If (u<$10000)
     b1 = ((u Shr 12) And $0f) Or $e0
     b2 = ((u Shr 6) And $3f) Or $80
     b3 = (u And $3f) Or $80    
     Return SetUTF8(ut,b1,b2,b3)   
 End If 

 If (u<$110000)
     b1 = ((u Shr 18) And $7) Or $f0
     b2 = ((u Shr 12) And $3f) Or $80
     b3 = ((u Shr 6) And $3f) Or $80
     b4 = (u And $3f) Or $80      
     Return SetUTF8(ut,b1,b2,b3,b4)
 End If 

End Function 

Function SetUTF8.UTF8(ut.UTF8, b1=0,b2=0,b3=0,b4=0)
  Local s$  
  If ut=Null Then ut=New UTF8  

  ut\byte[1] = b1
  ut\byte[2] = b2
  ut\byte[3] = b3
  ut\byte[4] = b4

  For z=1 To 4
      If ut\byte[z]=0 Then Exit
      s = s + ut\byte[z]
  Next 
  ut\s = s
  Return ut
End Function

;;=== And, here is "FastText_Unicode.BB" , include file ::===

; Encoding consts
Const FT_ASCII = 0
Const FT_UNICODE = 1

; Smooth const (LoadFont function)
Const FT_DEFAULT = 0
Const FT_NONANTIALIASED = 1
Const FT_ANTIALIASED = 2
Const FT_CLEARTYPE = 3

; Horisontal align consts (X axis)
Const FT_NONE = 0
Const FT_LEFT = 0
Const FT_CENTER = 1
Const FT_RIGHT = 2

; Vertical align consts (Y axis)
Const FT_TOP = 0
Const FT_MID = 1
Const FT_MIDDLE = 1
Const FT_BOTTOM = 2
Const FT_BASELINE = 3

; TextRect Formatting consts
Const FT_NOBREAK = 256
Const FT_NOCLIP = 512
Const FT_CALCRECT = 1024

Function LoadFont(name$="Tahoma", height=13, bold=0, italic=0, underline=0, angle#=0, smooth=FT_ANTIALIASED, encoding=FT_UNICODE)
	Return LoadFont_(name,height,bold,italic,underline,angle,smooth,encoding)
End Function

Function SetFont(font)
	SetFont_( font )
End Function

Function FreeFont(font)
	FreeFont_( font )
End Function

Function FontWidth()
	Return FontWidth_()
End Function

Function FontHeight()
	Return FontHeight_()
End Function

Function Text(x, y, txt$, cx=FT_LEFT, cy=FT_TOP, encoding=FT_UNICODE)
	Text_(x,y,txt,cx,cy,encoding)
End Function

Function TextRect(x, y, w, h, txt$, formatting=FT_LEFT, encoding=FT_UNICODE)
	Return TextRect_(x,y,w,h,txt,formatting,encoding)
End Function

Function TextBackground(r%=-1, g%=-1, b%=-1)
	TextBackground_ r,g,b
End Function

Function StringWidth(txt$, encoding=FT_UNICODE)
	Return StringWidth_(txt,encoding)
End Function

Function StringHeight(txt$, encoding=FT_UNICODE)
	Return StringHeight_(txt,encoding)
End Function

Code Archives Forum