~ Kludged code for division to remove 4 bugs.
~ Re-wrote Division to tidy the code. Division now 5-8 times faster.
~ Added square root. Just produces first 500 digits.
Later will give integer + residue.
Code: Select all
EnableExplicit
XIncludeFile "XIEngine.pbi"
Enumeration ;-Gadgets
#RegABContainer
#RegAText
#RegisterA
#RegBText
#RegisterB
#RegCContainer
#RegCText
#RegisterC
#ResidueRegText
#ResidueReg
#Oper
#Actions
#AddToRegA
#KeyFrame
#But0
#But1
#But2
#But3
#But4
#But5
#But6
#But7
#But8
#But9
#ButPlus
#ButMinus
#ButMul
#ButDiv
#ButGCD
#ButEquals
#ButPlusMinus
#ButDelChar
#ButClearEntry
#ButClearAll
#Constants
#Memories=#Constants+12
#RandomNumber=#Memories+12
#SquareRoot
#Factorial
#Powers
#Repunit9
#Functions
#ExtraFunctions
#MemoriesFrame
#ConstantsFrame
#Halfer
#Doubler
#ResTo1
#RegisterTransfers
#SwapReg
#Squarer
#Cuber
#NthPrime
#Regs2Memories
EndEnumeration
Enumeration ;Windows
#WinMain
#StatusBarWinMain
EndEnumeration
Enumeration ;MenuItems
#WinMainMenu
#Quit
#About
#Statistics
#DivTest
#CheckDivision
#TestBed
#EnterNums
#CopyRegisters
#MemoriesButtons
#Accuracy
#Copy
#Paste
#WinMainPopUpMenu
#HideMCoords
EndEnumeration
Enumeration #PB_Compiler_EnumerationValue ;Shortcuts
#Escape
#Return
#crtlC
#crtlV
#Key0
#Key1
#Key2
#Key3
#Key4
#Key5
#Key6
#Key7
#Key8
#Key9
#KeyPlus
#KeyMinus
#KeyMul
#KeyDiv
#KeyEquals
#KeyDelChar
#KeyClearEntry
#KeyClearAll
#SpeedTextKey
#AltD
#AltC
EndEnumeration ;Shortcuts
Enumeration ;Actions
#DoAdd
#DoSubtract
#DoMultiply
#DoDivide
#DoFactorial
#DoExp
#DoGCD
EndEnumeration
Global EntryMode.I=1 ;// 1=Input Register1 (1st number) etc.
Global ActionMode.I ;// Add Multiply etc.
Global Number1$, Number2$, Number3$, Number4$ ;// Strings of each register
Global CurrentDirectory$ = GetCurrentDirectory()
Global AMessage$
Global Dim Consts$(11)
Global Dim Memories$(11)
Global HideMouseCoordinates.I=1
Declare ClearButton()
Declare CreateWinMainGadgets()
Declare CreateWinMainMenu()
Declare CreateWinMainPopupMenu()
Declare DivTesterXI(M.I)
Declare DoAdd()
Declare DoCube()
Declare DoDouble()
Declare DoDivide()
Declare DoMultiply()
Declare DoSquare()
Declare DoSubtract()
Declare.S DotStr(I.I)
Declare DrawActionCharacter(ActionChar$)
Declare EventWinMain(EventID)
Declare HelpNumberEntry(HNum.I)
Declare InsertPrime(Primen.I,EMode.I)
Declare OpenWinMain()
Declare PutTextInRegister(RText$,RRegister.I)
Declare Setup()
Procedure About()
Protected A$
A$="CalcXI"+Chr(10)
A$+"Dave Ward December 2012 - January 2013"+Chr(10)+"Written in PureBasic"
MessageRequester("Extended Precision Integer Calculator",A$)
EndProcedure
Procedure Action_Add()
If Number1$<>""
ActionMode=#DoAdd
DrawActionCharacter("+")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=2
EndIf
EndProcedure
Procedure HelpNumberEntry(HNum.I)
Protected A$
Select HNum
Case 1
A$="Entering Numbers:"+Chr(10)+Chr(10)
A$+"Numbers can be entered via the 'on-screen keypad'"+Chr(10)
A$+"One can drag numbers onto the relevant register. From other applications or internal registers"+Chr(10)
Case 2
A$="Memories - there are 12, 0-11:"+Chr(10)+Chr(10)
A$+"To Save - Simply click on a register and drag to a memory button."+Chr(10)
A$+" - The r2m button saves registers to memories 8 - 11."+Chr(10)
A$+"To Copy - click a memory button to copy its contents to the currently active register."
Case 3
A$="Copying registers"+Chr(10)+Chr(10)
A$+"Numbers strings can be dragged or dropped between registers or external applications."+Chr(10)
A$+"Clicking a register places the contents on the clipboard."
Case 4
A$="Accuracy"+Chr(10)+Chr(10)
A$+"The array in the XI structure is set at 13000 which equates to 104,000 digits."
EndSelect
MessageRequester("Help!",A$)
EndProcedure
Procedure ClearButton()
ClearGadgetItems(#RegisterA)
SetGadgetText(#RegAText,"1st number")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$FF0000)
Number1$=""
ClearGadgetItems(#RegisterB)
SetGadgetText(#RegBText,"2nd number")
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$000000)
Number2$=""
ClearGadgetItems(#RegisterC)
SetGadgetText(#RegCText,"Result")
SetGadgetColor(#RegCText,#PB_Gadget_FrontColor,$000000)
Number3$=""
ClearGadgetItems(#ResidueReg)
SetGadgetText(#ResidueRegText,"Residue")
SetGadgetColor(#ResidueRegText,#PB_Gadget_FrontColor,$000000)
Number4$=""
EntryMode=1
DrawActionCharacter(" ")
StatusBarText(#StatusBarWinMain,0,"")
StatusBarText(#StatusBarWinMain,1,"")
EndProcedure
Procedure CreateWinMainGadgets()
Protected.L M, A$
ContainerGadget(#RegABContainer,20,20,766,163,#PB_Container_Raised)
TextGadget(#RegAText,5,0,350,17,"1st number (Register 1)",#PB_Text_Center)
SetGadgetColor(#RegAText,#PB_Gadget_BackColor,$DEC4B0)
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$FF0000)
ListViewGadget(#RegisterA,0,17,360,140)
GadgetToolTip(#RegisterA,"Register 1")
SetGadgetColor(#RegisterA,#PB_Gadget_BackColor,$87B8DE)
TextGadget(#RegBText,405,0,350,17,"2nd number (Register 2)",#PB_Text_Center)
SetGadgetColor(#RegBText,#PB_Gadget_BackColor,$DEC4B0)
ListViewGadget(#RegisterB,400,17,360,140)
GadgetToolTip(#RegisterB,"Register 2")
SetGadgetColor(#RegisterB,#PB_Gadget_BackColor,$E6D8AD)
CanvasGadget(#Actions,365,50,30,60)
DrawActionCharacter(" ")
CloseGadgetList()
ContainerGadget(#RegCContainer,420,210,366,340,#PB_Container_Raised)
TextGadget(#RegCText,5,0,350,17,"Result",#PB_Text_Center)
SetGadgetColor(#RegCText,#PB_Gadget_BackColor,$DEC4B0)
ListViewGadget(#RegisterC,0,17,360,140)
GadgetToolTip(#RegisterC,"Register 3")
TextGadget(#ResidueRegText,5,176,350,17,"Residue",#PB_Text_Center)
SetGadgetColor(#ResidueRegText,#PB_Gadget_BackColor,$DEC4B0)
ListViewGadget(#ResidueReg,0,193,360,140)
SetGadgetColor(#ResidueReg,#PB_Gadget_BackColor,$CDFAFF)
GadgetToolTip(#ResidueReg,"Register 4 - residue from division.")
CloseGadgetList()
Frame3DGadget(#KeyFrame,280,190,136,179,"Keypad")
ButtonGadget(#But9,350,237,30,30,"9")
ButtonGadget(#But8,318,237,30,30,"8")
ButtonGadget(#But7,286,237,30,30,"7")
ButtonGadget(#But6,350,269,30,30,"6")
ButtonGadget(#But5,318,269,30,30,"5")
ButtonGadget(#But4,286,269,30,30,"4")
ButtonGadget(#But3,350,301,30,30,"3")
ButtonGadget(#But2,318,301,30,30,"2")
ButtonGadget(#But1,286,301,30,30,"1")
ButtonGadget(#But0,286,333,30,30,"0")
ButtonGadget(#ButClearAll,286,206,30,30,"AC")
ButtonGadget(#ButClearEntry,318,206,30,30,"CE")
ButtonGadget(#ButDelChar,350,206,30,30,"Del")
ButtonGadget(#ButDiv,382,206,30,30,"/")
ButtonGadget(#ButMul,382,237,30,30,"x")
ButtonGadget(#ButMinus,382,269,30,30,"--")
ButtonGadget(#ButPlus,382,301,30,30,"+")
ButtonGadget(#ButEquals,382,333,30,30,"=")
ButtonGadget(#ButPlusMinus,350,333,30,30,Chr(177))
GadgetToolTip(#ButPlusMinus,"Changes the sign of the current register. Red indicates a negative number.")
Frame3DGadget(#Functions,170,190,105,179,"Functions")
ButtonGadget(#Squarer,176,206,30,30,"x"+Chr(178))
GadgetToolTip(#Squarer,"Squares the 1st number (register 1)")
ButtonGadget(#Cuber,208,206,30,30,"x"+Chr(179))
GadgetToolTip(#Cuber,"Cubes the 1st number (register 1)")
ButtonGadget(#Powers,240,206,30,30,"x^y")
GadgetToolTip(#Powers,"Enter Base in Register1, click x^y button then enter a positive power in Register2, click = button.")
ButtonGadget(#SquareRoot,176,238,30,30,"Sqr")
GadgetToolTip(#SquareRoot,"Enter Number in Register 1 then press Sqr key")
ButtonGadget(#Factorial,176,270,30,30,"!")
GadgetToolTip(#Factorial,"Factorial of 1st number (register 1)")
ButtonGadget(#Halfer,208,238,30,30,Chr(189))
GadgetToolTip(#Halfer,"Halves the 1st number (register 1)")
ButtonGadget(#Doubler,240,238,30,30,"x2")
GadgetToolTip(#Doubler,"Doubles the 1st number (register 1)")
ButtonGadget(#RandomNumber,176,302,30,30,"Rnd")
GadgetToolTip(#RandomNumber,"Enter Number of digits in register, then press Random Number key!")
ButtonGadget(#ButGCD,208,302,30,30,"GCD")
A$ = "Greatest Common Divisor: Enter number in Register 1 then press GCD."
GadgetToolTip(#ButGCD,A$ + " Place 2nd number in Register 2 and press =")
ButtonGadget(#NthPrime,176,334,30,30,"P[n]")
GadgetToolTip(#NthPrime,"Replaces the number [n] in register with Prime[n]")
Frame3DGadget(#ExtraFunctions,20,375,255,75,"ExtraFunctions")
ButtonGadget(#Repunit9,240,390,30,30,"Rep")
A$ = "Enter Number in register. Then press 'Rep'. 150 is replaced by"
GadgetToolTip(#Repunit9,A$+" a string of 50 1's - 675 by string of 75 6's.")
ButtonGadget(#AddToRegA,5,740,80,18,"Enter Number")
Frame3DGadget(#MemoriesFrame,20,450,395,50,"Memories")
For M=0 To 11
ButtonGadget(#Memories+M,27+32*M,467,28,28,Str(M))
GadgetToolTip(#Memories+M,Memories$(M))
EnableGadgetDrop(#Memories+M,#PB_Drop_Text,#PB_Drag_Copy)
Next M
Frame3DGadget(#ConstantsFrame,20,500,395,50,"Constants")
For M=0 To 11
ButtonGadget(#Constants+M,27+32*M,517,28,28,Chr(M+65))
GadgetToolTip(#Constants+M,Consts$(M))
Next M
Frame3DGadget(#RegisterTransfers,280,375,136,75,"Register Transfers")
ButtonGadget(#ResTo1,284,390,30,30,Chr(169))
GadgetToolTip(#ResTo1,"Moves Result to Register 1 - Clears other registers.")
ButtonGadget(#SwapReg,316,390,30,30,"1><2")
GadgetToolTip(#SwapReg,"Swaps Register 1 with Register 2")
ButtonGadget(#Regs2Memories,284,422,30,30,"r2m")
GadgetToolTip(#Regs2Memories,"Moves Register 1-4 to Memories 8-11.")
EnableGadgetDrop(#RegisterA,#PB_Drop_Text,#PB_Drag_Copy)
EnableGadgetDrop(#RegisterB,#PB_Drop_Text,#PB_Drag_Copy)
EnableGadgetDrop(#RegisterC,#PB_Drop_Text,#PB_Drag_Copy)
EnableGadgetDrop(#ResidueReg,#PB_Drop_Text,#PB_Drag_Copy)
EndProcedure
Procedure CreateWinMainMenu()
If CreateMenu(#WinMainMenu, WindowID(#WinMain))
MenuTitle("File")
MenuBar()
MenuItem( #HideMCoords, "Toggle Hide Mouse coordinates")
MenuBar()
MenuItem( #Quit, "&Quit")
MenuTitle("Edit")
MenuItem(#Copy,"Copy from current register (red title)"+Chr(9)+"ctrl+C")
MenuItem(#Paste,"Paste to current register (red title)"+Chr(9)+"ctrl+V")
MenuTitle("Help")
MenuItem(#About, "About")
MenuItem(#Statistics, "Speed Statistics"+Chr(9)+"Alt+S")
MenuBar()
OpenSubMenu("Using CalcXI")
MenuItem(#EnterNums,"Entering numbers")
MenuItem(#MemoriesButtons,"Memory buttons")
MenuItem(#CopyRegisters,"Copying Registers")
MenuItem(#Accuracy,"Accuracy.")
CloseSubMenu()
OpenSubMenu("Testing CalcXI")
MenuItem(#DivTest, "Divide Tester (100/50 random digits)"+Chr(9)+"Alt+D")
MenuItem(#CheckDivision, "Check Division (Reg2 * Reg3 + Res)"+Chr(9)+"Alt+C")
MenuItem(#TestBed, "Test Bed"+Chr(9)+"Alt+T")
CloseSubMenu()
EndIf
EndProcedure
Procedure CreateWinMainPopupMenu()
EndProcedure
Procedure DivTesterXI(M.I)
Protected.L FlagError, Temp$, dt.I, MM.I, HH.I, SS.I, Iterations.I, DivisorDigits.I, DividendDigits.I
Protected A$, DD$
Protected.XI DNum1, DNum2, DNum3, DNum4, DNum5, DNum6, DNum7, DNum8
dt=ElapsedMilliseconds()
FlagError=0
Iterations = 1000*1000*100
DivisorDigits = 25
DividendDigits = 125
DD$ = " - "+Str(DividendDigits)+"/"+Str(DivisorDigits) + " digits"
StatusBarText(#StatusBarWinMain,1,"Checking Division! " + DD$)
If OpenFile(0,CurrentDirectory$+"DivTestResults.txt")
FileSeek(0,Lof(0))
WriteStringN(0,FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss",Date())+" Starting run of "+DotStr(Iterations)+DD$)
WriteStringN(0,"")
For M=1 To Iterations
If DivisorDigits = 25 And DividendDigits = 125
A$=RSet("",25,Chr(Random(8)+49))+RSet("",25,Chr(Random(9)+48))
A$+RandomExactNumberXI(25)+RSet("",25,Chr(Random(9)+48))+RSet("",25,Chr(Random(9)+48))
ValXI(A$,@DNum1)
A$=RSet("",20,Chr(Random(8)+49))
A$+RandomExactNumberXI(10)+RSet("",20,Chr(Random(9)+48))
ValXI(A$,@DNum2)
Else
ValXI(RandomExactNumberXI(DividendDigits),@DNum1)
ValXI(RandomExactNumberXI(DivisorDigits),@DNum2)
EndIf
ZeroXI(@DNum3) : ZeroXI(@DNum4) : ZeroXI(@DNum5) : ZeroXI(@DNum6)
DivXI(@DNum1,@DNum2,@DNum3,@DNum4)
ZapLeadZeroesXI(@DNum4)
MultXI(@DNum2,@DNum3,@DNum5)
AddXI(@DNum4,@DNum5,@DNum6)
ZapLeadZeroesXI(@DNum6)
If EqualXI(@DNum1,@DNum6)=1
Else
FlagError+1
WriteStringN(0,"")
WriteStringN(0,"Test: "+Str(M)+" Error. "+FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss",Date()))
WriteStringN(0,"-----")
WriteStringN(0,"Dividend: "+Str8XI(@DNum1))
WriteStringN(0,"Divisor: "+Str8XI(@DNum2))
WriteStringN(0,"Answer: "+Str8XI(@DNum3))
WriteStringN(0,"Residue: "+Str8XI(@DNum4))
WriteStringN(0,"")
WriteStringN(0,"Dividend: "+Str8XI(@DNum1))
WriteStringN(0,"Check No: "+Str8XI(@DNum6))
WriteStringN(0,"")
EndIf
WindowEvent()
If M%10000=0
SS = (ElapsedMilliseconds()-dt)/1000
MM = SS / 60
SS = SS - MM * 60
HH = MM / 60
MM = MM - HH * 60
StatusBarText(#StatusBarWinMain,0,Space(45))
A$ = "Test: " + DotStr(M)+" - " + Right("00" + Str(HH),2) + ":"
StatusBarText(#StatusBarWinMain,0,A$ + Right("00" + Str(MM),2) + ":" + Right("00" + Str(SS),2))
EndIf
Next M
If FlagError=0
StatusBarText(#StatusBarWinMain,0," ")
StatusBarText(#StatusBarWinMain,0,"Test: "+ DotStr(M-1)+" No errors!")
WriteStringN(0,"Test completed: No Errors found. "+FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss",Date()))
WriteStringN(0,"")
Else
StatusBarText(#StatusBarWinMain,1,"Test: found "+Str(FlagError)+" errors!!")
EndIf
Else
MessageRequester("ERROR!","Cannot read file: "+CurrentDirectory$)
EndIf
CloseFile(0)
StatusBarText(#StatusBarWinMain,1,"")
EndProcedure
Procedure DoAdd()
Protected.XI ANum, BNum, CNum
ValXI(Number1$,@ANum.XI)
ValXI(Number2$,@BNum.XI)
AddXI(@ANum.XI,@BNum.XI,@CNum.XI)
PutTextInRegister(StrXI(@CNum.XI),3)
EndProcedure
Procedure DoCube()
Protected.XI ANum,CNum
Protected PE.I
ValXI(Number1$,@ANum)
PE=3
PowerXI(@ANum,PE,@CNum)
Number3$=StrXI(@CNum)
PutTextInRegister(Number3$,3)
EndProcedure
Procedure DoDouble()
Protected.XI ANum,CNum
EntryMode=2
ValXI(Number1$,@ANum)
DoubleXI(@ANum,@CNum)
Number3$=StrXI(@CNum)
PutTextInRegister(Number3$,3)
EntryMode=3
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegCText,#PB_Gadget_FrontColor,$FF0000)
SetGadgetColor(#ResidueRegText,#PB_Gadget_FrontColor,$000000)
EndProcedure
Procedure DoDivide()
Protected.XI ANum, BNum, CNum, Res
ZeroXI(@CNum)
ZeroXI(@Res)
ValXI(Number1$,@ANum.XI)
ValXI(Number2$,@BNum.XI)
DivXI(@ANum.XI,@BNum.XI,@CNum.XI,@Res.XI)
Number3$=StrXI(@CNum.XI)
PutTextInRegister(Number3$,3)
Number4$=StrXI(@Res.XI)
PutTextInRegister(Number4$,4)
EndProcedure
Procedure DoGCD()
Protected.XI ANum, BNum, CNum
ValXI(Number1$,@ANum.XI)
ValXI(Number2$,@BNum.XI)
GCDXI(@ANum.XI,@BNum.XI,@CNum.XI)
Number3$=StrXI(@CNum.XI)
PutTextInRegister(Number3$,3)
EndProcedure
Procedure DoHalf()
Protected.XI ANum,CNum,Res
EntryMode=2
ValXI(Number1$,@ANum)
HalveXI(@ANum,@CNum)
Number3$=StrXI(@CNum)
PutTextInRegister(Number3$,3)
Number4$=Str(Residue64Bit)
PutTextInRegister(Number4$,4)
EntryMode=3
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegCText,#PB_Gadget_FrontColor,$FF0000)
SetGadgetColor(#ResidueRegText,#PB_Gadget_FrontColor,$FF0000)
EndProcedure
Procedure DoMultiply()
Protected.XI ANum, BNum, CNum
ValXI(Number1$,@ANum.XI)
ValXI(Number2$,@BNum.XI)
MultXI(@ANum.XI,@BNum.XI,@CNum.XI)
Number3$=StrXI(@CNum.XI)
PutTextInRegister(Number3$,3)
EndProcedure
Procedure DoSquare()
Protected.XI ANum, CNum
ValXI(Number1$,@ANum.XI)
MultXI(@ANum.XI,@ANum.XI,@CNum.XI)
Number3$=StrXI(@CNum.XI)
PutTextInRegister(Number3$,3)
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegCText,#PB_Gadget_FrontColor,$FF0000)
EndProcedure
Procedure DoSubtract()
Protected.XI ANum, BNum, CNum
ValXI(Number1$,@ANum.XI)
ValXI(Number2$,@BNum.XI)
SubXI(@ANum.XI,@BNum.XI,@CNum.XI)
PutTextInRegister(StrXI(@CNum.XI),3)
EndProcedure
Procedure.S DotStr(I.I) ;// I prefer commas
;// Based upon post by Michael Vogel, 2011
Protected S.S = Str(Abs(I)), signi.S
If I < 0
Signi = "-"
Else
Signi = ""
EndIf
I=Len(S)
While I > 3
I - 3
S=InsertString(s,",",I + 1)
Wend
ProcedureReturn Signi + S
EndProcedure
Procedure DrawActionCharacter(ActionChar$)
If LoadFont(1, "Arial", 36): EndIf
StartDrawing(CanvasOutput(#Actions))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, 30, 60, RGB(240, 240, 240))
DrawingFont(FontID(1))
FrontColor(0)
DrawText(5,5,ActionChar$)
StopDrawing()
EndProcedure
Procedure EventWinMain(EventID)
Protected.I M, PE, Primen
Protected A$, B$, Digit$
Protected.XI ANum, CNum, Res
Select EventID
CompilerIf #PB_Compiler_Version > = 510
Case #EventPrimesBegun
StatusBarText(#StatusBarWinMain,2,"Generating Primes")
Case #EventPrimesDone
StatusBarText(#StatusBarWinMain,2,"Got: 5,761,455 Primes: 2 - 99,999,989")
CompilerEndIf
Case #PB_Event_Menu
Select EventMenu()
Case #Escape
End
Case #HideMCoords
HideMouseCoordinates=1-HideMouseCoordinates
StatusBarText(#StatusBarWinMain,3,"")
Case #Quit
End
Case #crtlV, #Paste
If EntryMode=1
PutTextInRegister(GetClipboardText(),1)
ElseIf EntryMode=2
PutTextInRegister(GetClipboardText(),2)
EndIf
Case #crtlC, #Copy
If EntryMode=1
SetClipboardText(Number1$)
ElseIf EntryMode=2
SetClipboardText(Number2$)
EndIf
Case #About
About()
Case #DivTest, #AltD
DivTesterXI(1)
Case #CheckDivision, #AltC
ValXI(Number1$,@RV1.XI)
ValXI(Number2$,@RV2.XI)
ValXI(Number3$,@RV3.XI)
ValXI(Number4$,@RV4.XI)
MultXI(@RV2.XI,@RV3.XI,@RV5.XI)
ZapLeadZeroesXI(@RV4.XI)
AddXI(@RV5.XI,@RV4.XI,@RV6.XI)
ZapLeadZeroesXI(@RV6.XI)
SubXI(@RV1.XI,@RV6.XI,@RV7)
ZapLeadZeroesXI(@RV7.XI)
If RV7\NumOfLimbs = 1 And RV7\Ra(1) = 0
AMessage$ = "Ok - Zero result"
Else
AMessage$ = "Error!"
EndIf
MessageRequester("Division check",AMessage$)
Case #Statistics, #SpeedTextKey
StatusBarText(#StatusBarWinMain,0,"")
StatusBarText(#StatusBarWinMain,1,"Speed Test!")
SpeedStatistics()
StatusBarText(#StatusBarWinMain,1,"")
Case #TestBed
Protected P.I, Carry.I, Result.I, X.I, Adjust.I, S.I, E.I
RV10\NumOfLimbs = 1
RV10\Ra(1) = 1
For M=1 To 1000
Carry = 0
For X = 1 To RV10\NumOfLimbs
Result = RV10\Ra(X) * Primes(M) + Carry
Carry = Result / Radix
RV10\Ra(X) = Result - Radix * Carry
Next X
If Carry > 0
RV10\NumOfLimbs + 1
RV10\Ra(RV10\NumOfLimbs) = Carry
EndIf
Next M
S=1 : E = RV10\NumOfLimbs
While E > S
Swap RV10\Ra(E) , RV10\Ra(S)
S + 1 : E - 1
Wend
Number1$ = StrXI(RV10)
PutTextInRegister(Number1$,1)
Case #EnterNums
HelpNumberEntry(1)
Case #MemoriesButtons
HelpNumberEntry(2)
Case #CopyRegisters
HelpNumberEntry(3)
Case #Accuracy
HelpNumberEntry(4)
Case #Key0 To #Key9
If EntryMode=1
Number1$+Str(EventGadget()-#Key0)
PutTextInRegister(Number1$,1)
ElseIf EntryMode=2
Number2$+Str(EventGadget()-#Key0)
PutTextInRegister(Number2$,2)
EndIf
Case #KeyPlus
Debug "++++++"
Action_Add()
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #AddToRegA
Case #But0 To #But9
If EntryMode=1
Number1$+Str(EventGadget()-#But0)
PutTextInRegister(Number1$,1)
ElseIf EntryMode=2
Number2$+Str(EventGadget()-#But0)
PutTextInRegister(Number2$,2)
EndIf
Case #ButPlus
Action_Add()
Case #ButMinus
If Number1$<>""
ActionMode=#DoSubtract
DrawActionCharacter("-")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=2
EndIf
Case #ButMul
If Number1$<>""
ActionMode=#DoMultiply
DrawActionCharacter("x")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=2
EndIf
Case #ButDiv
ActionMode=#DoDivide
DrawActionCharacter("/")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=2
Case #Powers
ActionMode=#DoExp
DrawActionCharacter("^")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=2
Case #ButGCD
ActionMode=#DoGCD
DrawActionCharacter("g")
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=2
Case #ButEquals
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegCText,#PB_Gadget_FrontColor,$FF0000)
SetGadgetColor(#ResidueRegText,#PB_Gadget_FrontColor,$FF0000)
EntryMode=3
Select ActionMode
Case #DoAdd
DoAdd()
Case #DoSubtract
DoSubtract()
Case #DoMultiply
DoMultiply()
Case #DoDivide
DoDivide()
Case #DoExp
ValXI(Number1$,@ANum.XI)
PE=Val(Number2$)
PowerXI(@ANum.XI,PE,@CNum.XI)
Number3$=StrXI(@CNum.XI)
PutTextInRegister(Number3$,3)
Case #DoGCD
DoGCD()
EndSelect
Case #Squarer
DoSquare()
Case #Cuber
DoCube()
Case #Doubler
DoDouble()
Case #Halfer
DoHalf()
Case #Factorial
FactorialXI(Val(Number1$),@CNum)
PutTextInRegister(StrXI(@CNum.XI),3)
SetGadgetColor(#RegAText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegBText,#PB_Gadget_FrontColor,$000000)
SetGadgetColor(#RegCText,#PB_Gadget_FrontColor,$FF0000)
DrawActionCharacter("!")
Case #ResTo1
A$=Number3$
ClearButton()
Number1$=A$
PutTextInRegister(Number1$,1)
Case #SwapReg
A$=Number1$
B$=Number2$
ClearButton()
Number1$=A$
Number2$=B$
Swap Number1$,Number2$
PutTextInRegister(Number1$,1)
PutTextInRegister(Number2$,2)
Case #Regs2Memories
Memories$(8) = Number1$
Memories$(9) = Number2$
Memories$(10) = Number3$
Memories$(11) = Number4$
For M=8 To 11
A$=Memories$(M)
If Len(A$)>100
A$=Left(A$,50)+"....."
EndIf
GadgetToolTip(#Memories+M,A$)
Next M
Case #ButDelChar
If EntryMode=1
Number1$=Left(Number1$,Len(Number1$)-1)
PutTextInRegister(Number1$,1)
ElseIf EntryMode=2
Number2$=Left(Number2$,Len(Number2$)-1)
PutTextInRegister(Number2$,2)
EndIf
Case #ButClearEntry
If EntryMode=1
ClearGadgetItems(#RegisterA)
Number1$=""
ElseIf EntryMode=2
ClearGadgetItems(#RegisterB)
Number2$=""
EndIf
Case #ButClearAll
ClearButton()
Case #ButPlusMinus
Select EntryMode
Case 1
If Left(Number1$,1)="-"
Number1$=Mid(Number1$,2)
Else
Number1$="-"+Number1$
EndIf
PutTextInRegister(Number1$,1)
Case 2
If Left(Number2$,1)="-"
Number2$=Mid(Number2$,2)
Else
Number2$="-"+Number2$
EndIf
PutTextInRegister(Number2$,2)
EndSelect
Case #RandomNumber
If EntryMode=1
MakeRandomstring(Val(Number1$),EntryMode)
ElseIf EntryMode=2
MakeRandomstring(Val(Number2$),EntryMode)
EndIf
Case #SquareRoot
ValXI(Number1$,@ANum.XI)
SqrXI(@ANum.XI,@CNum.XI)
Number3$=StrXI(@CNum.XI)
PutTextInRegister(Number3$,3)
Case #NthPrime
If EntryMode=1
Primen = Val(Number1$)
ElseIf EntryMode=2
Primen = Val(Number2$)
EndIf
If Primen < 5761456
InsertPrime(Primen,EntryMode)
Else
MessageRequester("WARNING!","Max is 5,761,455")
EndIf
Case #Repunit9
If EntryMode=1
Digit$=Left(Number1$,1)
Number1$=Mid(Number1$,2)
MakeRepString(Digit$,Val(Number1$),EntryMode)
ElseIf EntryMode=2
Digit$=Left(Number2$,1)
Number2$=Mid(Number2$,2)
MakeRepString(Digit$,Val(Number2$),EntryMode)
EndIf
Case #RegisterA
SetClipboardText(Number1$)
StatusBarText(#StatusBarWinMain,0,"1st Number on Clipboard")
Case #RegisterB
SetClipboardText(Number2$)
StatusBarText(#StatusBarWinMain,0,"2nd Number on Clipboard")
Case #RegisterC
SetClipboardText(Number3$)
StatusBarText(#StatusBarWinMain,0,"Result on Clipboard")
Case #ResidueReg
SetClipboardText(Number4$)
StatusBarText(#StatusBarWinMain,0,"Residue on Clipboard")
Case #Memories To #Memories+11
If EntryMode=1
Number1$=Memories$(EventGadget()-#Memories)
PutTextInRegister(Number1$,1)
ElseIf EntryMode=2
Number2$=Memories$(EventGadget()-#Memories)
PutTextInRegister(Number2$,2)
EndIf
Case #Constants To #Constants+11
If EntryMode=1
Number1$=Consts$(EventGadget()-#Constants)
PutTextInRegister(Number1$,1)
ElseIf EntryMode=2
Number2$=Consts$(EventGadget()-#Constants)
PutTextInRegister(Number2$,2)
EndIf
EndSelect
Case #PB_Event_GadgetDrop
Select EventGadget()
Case #RegisterA
Number1$=EventDropText()
PutTextInRegister(Number1$,1)
Case #RegisterB
Number2$=EventDropText()
PutTextInRegister(Number2$,2)
Case #Memories To #Memories+11
Memories$(EventGadget()-#Memories)=EventDropText()
A$=EventDropText()
If Len(A$)>100
A$=Left(A$,50)+"....."
EndIf
GadgetToolTip(EventGadget(),A$)
EndSelect
Case #PB_Event_CloseWindow
If WindowID(#WinMain)
End
EndIf
EndSelect
If EventID = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
Select EventGadget()
Case #RegisterA
DragText(Number1$)
Case #RegisterB
DragText(Number2$)
Case #RegisterC
DragText(Number3$)
Case #ResidueReg
DragText(Number4$)
EndSelect
EndIf
If HideMouseCoordinates=0
A$="X: "+Str(WindowMouseX(#WinMain))+" Y: "+Str(WindowMouseY(#WinMain))
StatusBarText(#StatusBarWinMain,3,A$)
EndIf
EndProcedure
Procedure InsertPrime(Primen.I,EMode.I)
If EMode=1
Number1$=Str(primes(Primen))
PutTextInRegister(Number1$,EMode)
ElseIf EMode=2
Number2$=Str(primes(Primen))
PutTextInRegister(Number2$,EMode)
EndIf
EndProcedure
Procedure MakeRandomstring(NumOfDigits.I,EMode)
Protected YNReply.I
If NumOfDigits > 7200
Repeat
YNReply = MessageRequester("WARNING!!","Your are about to create a very large number."+Chr(10)+"Do you wish To proceed?",#PB_MessageRequester_YesNo)
If YNReply = #PB_MessageRequester_No
ProcedureReturn
ElseIf YNReply = #PB_MessageRequester_Yes
Break
EndIf
ForEver
EndIf
If EMode=1
Number1$=RandomExactNumberXI(NumOfDigits)
PutTextInRegister(Number1$,EMode)
ElseIf EMode=2
Number2$=RandomExactNumberXI(NumOfDigits)
PutTextInRegister(Number2$,EMode)
EndIf
EndProcedure
Procedure MakeRepString(Digit$,NumOfDigits.I,EMode)
If EMode=1
Number1$=RSet(Digit$,NumOfDigits,Digit$)
PutTextInRegister(Number1$,EMode)
ElseIf EMode=2
Number2$=RSet(Digit$,NumOfDigits,Digit$)
PutTextInRegister(Number2$,EMode)
EndIf
EndProcedure
Procedure OpenWinMain()
Protected.D V
Protected.L Xpos, Ypos, Width, Height, Flags
Protected Title$
Title$="CalcXI - Extended Precision Integer Calculator. Version: 0.88"
Xpos=0
Ypos=0
Width=800
Height=600
Flags= #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget
If OpenWindow(#WinMain,Xpos,Ypos,Width,Height,Title$,Flags)
If LoadFont(0, "Arial", 8, #PB_Font_Bold)
SetGadgetFont(#PB_Default, FontID(0)) ; Set the loaded Arial 16 font as new standard
EndIf
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Escape, #Escape)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_C | #PB_Shortcut_Control, #crtlC)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_V | #PB_Shortcut_Control, #crtlV)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_S | #PB_Shortcut_Alt, #SpeedTextKey)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_D | #PB_Shortcut_Alt, #AltD)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_C | #PB_Shortcut_Alt, #AltC)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_0 , #Key0)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_1 , #Key1)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_2 , #Key2)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_3 , #Key3)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_4 , #Key4)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_5 , #Key5)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_6 , #Key6)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_7 , #Key7)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_8 , #Key8)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_9 , #Key9)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad0 , #Key0)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad1 , #Key1)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad2 , #Key2)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad3 , #Key3)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad4 , #Key4)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad5 , #Key5)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad6 , #Key6)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad7 , #Key7)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad8 , #Key8)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Pad9 , #Key9)
AddKeyboardShortcut(#WinMain, #PB_Shortcut_Add, #KeyPlus)
Setup()
CreateWinMainMenu()
CreateWinMainGadgets()
CreateWinMainPopupMenu()
CreateStatusBar(#StatusBarWinMain,WindowID(#WinMain))
AddStatusBarField(250)
AddStatusBarField(250)
AddStatusBarField(200)
AddStatusBarField(95)
Else
MessageRequester("", "Error")
End
EndIf
EndProcedure
Procedure PutTextInRegister(RText$,RRegister.I)
Protected.L DigitsPerLine, DigitsPerGroup, RTextLen, M, N, SignAdjust, DPAdust
Protected Line$, RChar$
DigitsPerLine=50
DigitsPerGroup=5
RText$=ReplaceString(RText$," ","")
RTextLen=Len(RText$)
RChar$=Mid(RText$,M,1)
SignAdjust=0
DPAdust=0
For M=1 To RTextLen
If RChar$ ="+" Or RChar$ = "-"
SignAdjust=1
ElseIf RChar$ = "."
DPAdust=1
ElseIf RChar$ <"0" Or RChar$ >"9"
MessageRequester("ERROR!","Not a decimal integer!")
ProcedureReturn
EndIf
Next M
Select RRegister
Case 1
ClearGadgetItems(#RegisterA)
M=1
Repeat
Line$=""
N=1
Repeat
Line$+Mid(Rtext$,N+M-1,DigitsPerGroup)+" "
N+DigitsPerGroup
Until DigitsPerLine<N
AddGadgetItem(#RegisterA,-1,Line$)
M+DigitsPerLine
Until RTextLen<M
Number1$=RText$
SetGadgetText(#RegAText,"1st number "+Str(RTextLen-SignAdjust-DPAdust)+" digits. Lines: "+Str((RTextLen-1)/DigitsPerLine+1))
Case 2
ClearGadgetItems(#RegisterB)
M=1
Repeat
Line$=""
N=1
Repeat
Line$+Mid(Rtext$,N+M-1,DigitsPerGroup)+" "
N+DigitsPerGroup
Until DigitsPerLine<N
AddGadgetItem(#RegisterB,-1,Line$)
M+DigitsPerLine
Until RTextLen<M
Number2$=RText$
SetGadgetText(#RegBText,"2nd number "+Str(RTextLen-SignAdjust-DPAdust)+" digits. Lines: "+Str((RTextLen-1)/DigitsPerLine+1))
Case 3 ;// Answer
SetGadgetText(#RegCText,"Result "+Str(RTextLen-SignAdjust-DPAdust)+" digits. Lines: "+Str((RTextLen-1)/DigitsPerLine+1))
ClearGadgetItems(#RegisterC)
M=1
Repeat
Line$=""
N=1
Repeat
Line$+Mid(Rtext$,N+M-1,DigitsPerGroup)+" "
N+DigitsPerGroup
Until DigitsPerLine<N
AddGadgetItem(#RegisterC,-1,Line$)
M+DigitsPerLine
Until RTextLen<M
Number3$=RText$
Case 4 ;// Residue
SetGadgetText(#ResidueRegText,"Residue "+Str(RTextLen-SignAdjust-DPAdust)+" digits. Lines: "+Str((RTextLen-1)/DigitsPerLine+1))
ClearGadgetItems(#ResidueReg)
M=1
Repeat
Line$=""
N=1
Repeat
Line$+Mid(Rtext$,N+M-1,DigitsPerGroup)+" "
N+DigitsPerGroup
Until DigitsPerLine<N
AddGadgetItem(#ResidueReg,-1,Line$)
M+DigitsPerLine
Until RTextLen<M
Number4$=RText$
EndSelect
EndProcedure
Procedure Setup()
Protected.L M
CreateThread(@PrimeGenerator(),120)
Tens(0)=1
For M=1 To 17
Tens(M)=Tens(M-1)*10
Next M
Consts$(0)="11111111111111000000000000011111100";"30079336755242834368044586304632296300765"
Consts$(1)="111111111111111111";"9872410987691906804355928752240"
Consts$(2)="99999999999999000"
Consts$(3)="11111111122222100"
Consts$(4)="1243617733990094836481" ;// '5' cube + '6' cube = 9x '7' cube
Consts$(5)="487267171714352336560"
Consts$(6)="609623835676137297449"
Consts$(8)="123456789123456789"
Consts$(9)="123456789"
Consts$(10)="83206617694944969819571878187315898937987043179"
Consts$(11)="85133670478476560299637"
EndProcedure
Start:
OpenWinMain()
Repeat
Define.L EventID
EventID = WaitWindowEvent(20)
If EventID
Select EventWindow()
Case #WinMain
EventWinMain(EventID)
EndSelect
EndIf
ForEver
End