A handy multiplier

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
albert_redditt
User
User
Posts: 14
Joined: Mon Jul 20, 2009 9:29 pm
Location: Santa Barbara California US

A handy multiplier

Post by albert_redditt »

Code: Select all

Procedure Multiplier(a.s,b.s,c.s)
  output.s = ""
  output2.s = ""
  answer.s = ""
  result.s = ""
  int1.s = ""
  int2.s = ""
  frac1.s = ""
  frac2.s = ""
  outsign.s = ""
  ltgt.s = "="

  number1.s = a.s 
  number2.s = b.s 
  outsign = c.s
  
  number1 = Mid(number1,2)
  number2 = Mid(number2,2)
  dec1 = FindString(number1,".",1) 
  dec2 = FindString(number2,".",1)
  int1 = Left(number1,dec1-1)
  int2 = Left(number2,dec2-1)
  frac1 = Right(number1,Len(number1) - dec1)
  frac2 = Right(number2,Len(number2) - dec2)
  number1 = int1 + frac1
  number2 = int2 + frac2
  decpos1 = Len(frac1)
  decpos2 = Len(frac2)
  decpos3 = decpos1 + decpos2

  output = ""
  carry = 0
  count1 = Len(number2)
  zeros = 0
  While count1 >= 1
    For count2 = Len(number1) To 1 Step -1
      val1 = Val(Mid(number1,count2,1))
      val2 = Val(Mid(number2,count1,1))
      result = Trim(Str((val1 * val2) + carry))
      carry = 0
      If Len(result) = 2
        answer = answer + Right(result,1)
        carry = Val(Left(result,1))   
      Else
        answer = answer + result
      EndIf
    Next
    If carry >= 1
      answer = answer + Trim(Str(carry))  
    EndIf
    count1 = count1 - 1  
    output2 = output

    output = Space(zeros)
    For count2 = 1 To Len(answer)
      output = output + Mid(answer,count2,1)
    Next
    
    spaces = Len(output) - Len(output2)
    output2 = output2 + Space(spaces)
    zeros = zeros + 1

    answer = ""
    carry = 0
    For count2 = 1 To Len(output)
      val1 = Val(Mid(output ,count2,1))
      val2 = Val(Mid(output2,count2,1))
      result = Trim(Str(val1 + val2 + carry))
      carry = 0
      If Len(result) = 2
        answer = answer + Right(result,1)
        carry =  Val(Left(result,1))
      Else
        answer = answer + result  
      EndIf
    Next
    If carry >= 1 
      answer = answer + Trim(Str(carry))
    EndIf

    output = ""
    For count2 = 1 To Len(answer) 
      output = output + Mid(answer,count2,1)
    Next   
    answer = ""
  Wend

  For count1 = Len(output) To 1 Step -1
    answer = answer + Mid(output,count1,1)
  Next
  output = answer
  answer = ""
  
  For count1 = Len(output) To 1 Step -1
    If count1 =  Len(output) - decpos3
      answer = answer + "."
    EndIf
    answer = answer + Mid(output,count1,1)
  Next
  output = ""
  For count1 = Len(answer) To 1 Step -1
      output = output + Mid(answer,count1,1)
  Next

;trying to trim leading and trailing zeros
;Debug output  
;  dec1 = FindString(output,".",1)
;  If dec1 <> 2
;    count2 = 1
;    For count1 = 1 To Len(output)
;      If Val(Mid(output,count1,1)) > 0 Or Mid(output,count1,1) = "."
;        Break
;      EndIf      
;      If Mid(output,count1,1) = "0"
;        count2 = count2 + 1
;      EndIf
;    Next
;  EndIf

;  output = Mid(output,count2)
;  If Left(output,1)= "."
;    output = "0" + output
;  EndIf

;  dec1 = FindString(output,".",1)
;  If Len(output) > dec1
;    count2 = Len(output)
;    For count1 = Len(output) To 1 Step -1
;      If Val(Mid(output,count1,1)) > 0
;        Break
;      EndIf      
;      If Mid(output,count1,1) = "0"
;        count2 = count2 - 1
;      EndIf
;    Next
;  EndIf
; output = Left(output,count2)

  SetGadgetText(#Editor_3, outsign + output)
EndProcedure




albert_redditt
User
User
Posts: 14
Joined: Mon Jul 20, 2009 9:29 pm
Location: Santa Barbara California US

The full calculator is available here

Post by albert_redditt »

http://www.mediafire.com/?sharekey=a375 ... f6e8ebb871

It dosen't divide, save or load yet. I ran out of room in the Demo Version and I'm waiting for the full version so i can finish it.

it truncates integer portion at 5,000,000 places and the decimal portion at 5,000,000 places for a total of 10 megabytes strings.
its accurate on the add,sub and mul to that many places the output is not truncated so a mul could output a 20 megabyte value.

The Cyphers were written in fnxbasic at http://www.fnxbasic.com
Post Reply