'===========================================================================
' Subject: STRING-NUMBER LIBRARY             Date: 05-25-00 (12:11)       
' Author:  Andreas van Cranenburgh           Code: QB, QBasic, PDS        
' Origin:  andreaswolf@mail.com            Packet: ALGOR.ABC
'===========================================================================
'String-Number library - By Andreas van Cranenburgh (C) 2000
'    Mail any suggestions and bug reports to andreaswolf@mail.com
'You can calculate with numbers of upto 32767 digits (limit of a string).
'The code is probably very inefficient and buggy so don't expect too much.
'Things that seem to work:
' o Addition
' o Substraction
' o Multiplication
' o (integer) Division and Modulus
' o (integer) Power
' o Square root
'   þ Integer part only. It uses QB's division because otherwise it
'     wouldn't work. Sometimes the loop doesn't end, I don't know why yet.
' o Factorials
' o Fibonacci series
' o Number of Permutations and number of Combinations
'    PS-that's nCr and nPr on your Casio.
'Things that do NOT work (!@#%&<>)
' o Hexadecimal
'   þ Sorry, I really don't know why the heck it doesn't work...
'Things to look for:
' o Support for BCD method
'   þ BCD stands for Binary Coded Decimal, this way it's possible to store
'     two decimal digits in one byte (it could also be done in 7 bits)
'     this is an efficient method, but I still can't seem to get it working.
'Things that will NOT be implented:
' o Floating point. It would make the library too cimplicated and too slow,
'   [I guess].
'Notes
' o Zero is returned as "0".
' o Simple error checking is done but it is not possible to find out what
'   error occured.
' o Please send me any formulas you might want to have implented, I will do
'   my best to actually make this program useful...
DEFINT A-Z                              'All variables are assumed to be integers.
DECLARE SUB PokeChar (Char%, Fore%, Back%) 'Print character without side effects like bells and new lines
DECLARE FUNCTION DRE.Bin2Dec% (Bit$)    'Binary to decimal
DECLARE FUNCTION DRE.Dec2Bin$ (Decimal%) 'Deicmal to binary
DECLARE FUNCTION FCol$ (FG%)            'Change color
DECLARE FUNCTION DRE.Dec2Nl$ (Number)   'Decimal to dutch litteral
DECLARE FUNCTION DRE.Dec2Eng$ (Number)  'Decimal to english litteral
DECLARE FUNCTION DRE.Dec2Rom$ (Number)  'Decimal to roman
DECLARE FUNCTION DRE.Rom2Dec (Roman$)   'Roman to decimal
DECLARE FUNCTION IsPrimeD% (Num#)       'Is Num# (DOUBLE) prime? (no that's not a question, it's what this function is for :)
DECLARE FUNCTION IsPrime% (Num$)        'Don't use this one, this one is slow!
DECLARE SUB NumPrint (Num$, CharsPerColumn)
                                        'Print numbers in columns with 'CharsPerColumn' digits.
DECLARE SUB NumTrim (Num$)              'Delete spaces and excess of zeros in a number.
DECLARE SUB ReColor (Y1%, X1%, Y2%, X2%, Fore%, Back%)
                                        'Changes colors without deleting text.
DECLARE FUNCTION StrAdd$ (Num1$, Num2$) 'Add two numbers.
DECLARE FUNCTION StrSub$ (Num1$, Num2$) 'Subtract two numbers.
DECLARE FUNCTION StrMul$ (Num1$, Num2$) 'Multiplicate two numbers.
DECLARE FUNCTION StrDiv$ (Num1$, Num2$) 'Divide two numbers
DECLARE FUNCTION StrMod$ (Num1$, Num2$) 'Modulus of Num1$ and Num2$
DECLARE FUNCTION StrPwr$ (Num1$, Num2$) 'Raise Num1$ to the power of Num2$
DECLARE FUNCTION StrFac$ (Fac$)         'Returns faculty of a number
DECLARE FUNCTION StrFib$ (Num$)         'Calculates Fibonacci series
DECLARE FUNCTION StrSqr$ (Num$)         'Square root of Num$ (integer ofcourse)
DECLARE FUNCTION StrComb$ (Num1$, Num2$)     'Number of combinations
DECLARE FUNCTION StrPerm$ (Num1$, Num2$)     'Number of permutations
DECLARE FUNCTION StrSmaller (Num1$, Num2$) 'Is first one smaller than last one?
DECLARE FUNCTION StrGreater (Num1$, Num2$) 'Is first one greater than last one?
DECLARE FUNCTION Factorial# (Num)         'Returns factorial (maximum: 171)
DECLARE FUNCTION DMod# (Num1#, Num2#)   'QB MOD equivelant for DOUBLEs
DECLARE FUNCTION NumS$ (Num%)           'shortcut for LTRIM$(STR$(n))
DECLARE FUNCTION Min (Num1, Num2)       'Returns lowest number of two integers.
DECLARE FUNCTION Max (Num1, Num2)       'Returns highest number of two integers.
DECLARE FUNCTION SelectChoice% (Choices$(), Y1%, X1%, X2%, TextFore%, TextBack%, SelFore%, SelBack%)
                                        'Used by GUI
DIM Stats(36)
CONST SignChar = "-"
CONST BCDMethod = 0              'still not working
COMMON SHARED CharBase, StartingChar
StartingChar = 48                ' ASCII 48 = "0"
CharBase = 10                    '0123456789
'-Í=ð=Í-Í=ð=Í-Í=ð=Í-DEMO STARTS HEREð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=
'ON ERROR GOTO Handler                   'To trap division by zero
CLS                                     'Clear screen
DIM Choices$(10), Options$(5)
Choices$(0) = "Í"
Choices$(1) = "  Perform simple calculations (+, -, *, /)   "
Choices$(2) = "  Power and square root                      "
Choices$(3) = "  Factorial (5! = 1*2*3*4*5)                 "
Choices$(4) = "  Fibonacci series ( f(5)=(((1+2)+3)+4)+5 )  "
Choices$(5) = "  Primes                                     "
Choices$(6) = "  Base conversion                            "
Choices$(7) = "  Number statistics                          "
Choices$(8) = "  Options                                    "
Choices$(9) = "  Exit program                               "
MenuCount = 9
Options$(0) = "Í"
Options$(1) = "  Enter base                                 "
Options$(2) = "  Enter output file                          "
Options$(3) = "  Close output file                          "
Options$(4) = "  Back                                       "
COLOR 7
DO
  LOCATE 1, 4
  COLOR , 0
  COLOR 10: PRINT "StrNum (C) 2000 by Andreas van Cranenburgh - ";
  COLOR 11: PRINT "andreaswolf@mail.com";
  COLOR 14, 1
  LOCATE 2, 5
  a$ = "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
  SELECT CASE CharBase
  CASE 2
    MID$(a$, 3) = "Base: Binary"
  CASE 8
    MID$(a$, 3) = "Base: Octal"
  CASE 10
    MID$(a$, 3) = "Base: Decimal"
  CASE 16
    MID$(a$, 3) = "Base: Hexadecimal"
  CASE ELSE
    MID$(a$, 3) = "Base:" + STR$(CharBase)
  END SELECT
  IF SaveResults THEN MID$(a$, 21) = "Log file: " + File$
  PRINT a$
  FOR a = 1 TO MenuCount
    LOCATE , 5
    PRINT "º                                             º"
  NEXT a
  LOCATE MenuCount + 3, 5
  a$ = "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
  IF t! <> 0 THEN MID$(a$, 5) = "Last operation took" + STR$(t!) + " seconds"
  PRINT a$
  Choice = SelectChoice(Choices$(), 3, 6, 50, 15, 1, 0, 3)
  SELECT CASE Choice
  CASE 1
    COLOR 7, 0
    SCREEN , , 1, 1
    LOCATE 24, 1
    PRINT "First number: ";
    COLOR 15: INPUT "", Num1$
    COLOR 7: PRINT "Second number: ";
    COLOR 15: INPUT "", Num2$
    COLOR 7
    NumTrim Num1$
    NumTrim Num2$
    IF CharBase = 10 THEN
      PRINT "               ", "StrNum:", " QuickBasic:"
      PRINT "Sum:           ", StrAdd$(Num1$, Num2$), VAL(Num1$) + VAL(Num2$)
      PRINT "Difference:    ", StrSub$(Num1$, Num2$), VAL(Num1$) - VAL(Num2$)
      PRINT "Product:       ", StrMul$(Num1$, Num2$), VAL(Num1$) * VAL(Num2$)
      PRINT "Quotient (INT):", StrDiv$(Num1$, Num2$), VAL(Num1$) \ VAL(Num2$)
      PRINT "Modulus:       ", StrMod$(Num1$, Num2$), VAL(Num1$) MOD VAL(Num2$)
    ELSE
      PRINT "Sum:           ",
      NumPrint StrAdd$(Num1$, Num2$), 5
      PRINT "Difference:    ",
      NumPrint StrSub$(Num1$, Num2$), 5
      PRINT "Product:       ",
      NumPrint StrMul$(Num1$, Num2$), 5
      PRINT "Quotient (INT):",
      NumPrint StrDiv$(Num1$, Num2$), 5
      PRINT "Modulus:       ",
      NumPrint StrMod$(Num1$, Num2$), 5
    END IF
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
  CASE 2
    SCREEN , , 1, 1
    LOCATE 24, 1
    PRINT "First number: ";
    COLOR 15: INPUT "", Num1$
    COLOR 7: PRINT "Second number: ";
    COLOR 15: INPUT "", Num2$
    COLOR 7
    NumTrim Num1$
    NumTrim Num2$
    PRINT Num1$; " raised to the power of "; Num2$; " =";
    OutCome$ = StrPwr$(Num1$, Num2$)
    NumPrint OutCome$, 5
    PRINT "û"; Num1$; " = ";
    NumPrint StrSqr$(Num1$), 5
    IF SaveResults THEN
      PRINT #1, Num1$; " raised to the power of "; Num2$; " ="; OutCome$
    END IF
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
  CASE 3
    SCREEN , , 1, 1
    LOCATE 24, 1
    PRINT "Number > 0: ";
    COLOR 15: INPUT "", Num1$
    COLOR 23: PRINT " Calculating - Please wait"; : COLOR 7
    t! = TIMER
    OutCome$ = StrFac$(Num1$)
    t! = TIMER - t!         'Calculate time needed
    LOCATE , 1: PRINT "                          "; : LOCATE , 1:
    PRINT Num1$; "! =";
    NumPrint OutCome$, 5
    FOR a = LEN(OutCome$) TO 1 STEP -1
      IF MID$(OutCome$, a, 1) <> "0" THEN EXIT FOR
    NEXT a
    PRINT LEN(OutCome$) - a; "trailing zero's in faculty"
    IF SaveResults THEN
      PRINT #1, Num1$; "! ="; OutCome$
    END IF
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
  CASE 4
    SCREEN , , 1, 1
    LOCATE 24, 1
    PRINT "Number > 0: ";
    COLOR 15: INPUT "", Num1$
    LOCATE CSRLIN - 1
    COLOR 23: PRINT " Calculating - Please wait"; : COLOR 7
    t! = TIMER
    OutCome$ = StrFib$(Num1$)
    t! = TIMER - t!         'Calculate time needed
    LOCATE , 1
    LOCATE , 1: PRINT "                          "; : LOCATE , 1:
    PRINT "F("; Num1$; ") =";
    NumPrint OutCome$, 5
    IF SaveResults THEN
      PRINT #1, "F("; Num1$; ") ="; OutCome$
    END IF
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
  CASE 5                      'Primes
    SCREEN , , 1, 1
    LOCATE 24, 1
    COLOR 10, 0: PRINT "Enter number to get the Nth prime or hit enter to list all until you press ESC"
    COLOR 7: PRINT "Number: ";
    COLOR 15: INPUT "", Num$
    COLOR 7
    IF Num$ = "" THEN
      PRINT "p(1) = 1"
      PRINT "p(2) = 2"
      PRINT "p(3) = 3"
      PRINT "p(4) = 5"
      CurrentPrime# = 4
      TestNum# = 99999999999#     'TestNum$="5"
      'TestNum# = 5
      DO UNTIL k$ = CHR$(27)
        TestNum# = TestNum# + 2   'TestNum$ = StrAdd$(TestNum$, "2")
        IF IsPrimeD(TestNum#) THEN  'IsPrime(TestNum$)
          CurrentPrime# = CurrentPrime# + 1
          PRINT "p("; CurrentPrime#; ") =";
          PRINT TestNum#
        END IF
        k$ = INKEY$
      LOOP
      IF SaveResults THEN
        PRINT #1, "p("; CurrentPrime#; ") ="; TestNum#
      END IF
      OutCome$ = LTRIM$(STR$(TestNum#))
    ELSE
      PRINT "p(1) = 1"
      PRINT "p(2) = 2"
      PRINT "p(3) = 3"
      PRINT "p(4) = 5"
      CurrentPrime# = 4
      TestNum# = 5      'TestNum$="5"
      ToNum# = VAL(Num$)
      t! = TIMER
      TestNum# = 3
      DO
        TestNum# = TestNum# + 2      'TestNum$ = StrAdd$(TestNum$, "2")
        IF IsPrimeD(TestNum#) THEN   'IsPrime(TestNum$)
          CurrentPrime# = CurrentPrime# + 1
          PRINT "p("; CurrentPrime#; ") =";
          PRINT TestNum#
        END IF
      LOOP UNTIL CurrentPrime# >= ToNum#
      IF SaveResults THEN
        PRINT #1, "p("; CurrentPrime#; ") ="; TestNum#
      END IF
      OutCome$ = LTRIM$(STR$(TestNum#))
      t! = TIMER - t!
    END IF
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
  CASE 6                      'Base conversion
    SCREEN , , 1, 1
    LOCATE 24, 1
    COLOR 10, 0: PRINT "Proceed with &H for hexadecimal, &O for octal, &B for binary and &R for Roman"
    COLOR 7: PRINT "Number: ";
    COLOR 15: INPUT "", Num$
    IF LEFT$(Num$, 2) = "&R" THEN
      a = DRE.Rom2Dec(MID$(Num$, 3))
    ELSEIF LEFT$(Num$, 2) = "&B" THEN
      a = DRE.Bin2Dec(MID$(Num$, 3))
    ELSEIF LEFT$(Num$, 2) = "&C" THEN
      a = ASC(MID$(Num$, 3))
    ELSE
      a = VAL(Num$)
    END IF
    a = INT(a)
    IF ABS(a) <> a THEN
      a = ABS(a)
      M$ = "-"
    END IF
    COLOR 15: PRINT "DEC: "; FCol$(7); M$; NumS$(a);
    COLOR 15: PRINT " HEX: "; FCol$(7); M$; HEX$(a);
    COLOR 15: PRINT " OCT: "; FCol$(7); M$; OCT$(a);
    COLOR 15: PRINT " BIN: "; FCol$(7); M$; DRE.Dec2Bin$(a);
    IF a < 4000 AND a >= 0 THEN PRINT FCol$(15); " ROM: "; M$; FCol$(7); DRE.Dec2Rom$(a);
    IF a < 256 AND a >= 0 AND M$ = "" THEN
      PRINT FCol$(15); " CHR: ";
      PokeChar a, 7, 0
      LOCATE , POS(0) - (POS(0) < 80)
    END IF
    IF M$ <> "" THEN M$ = "minus "
    PRINT FCol$(15); " ENG: "; FCol$(7); M$ + DRE.Dec2Eng$(a);
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
 CASE 7                     'Number statistics
    SCREEN , , 1, 1
    LOCATE 24, 1
    COLOR 10, 0: PRINT "You can only view statistics for Powers, factorials, fibonaccis and primes"
    COLOR 7
    PRINT "Number: "
    NumPrint OutCome$, 5
    PRINT "Digit", "Matches", "Percent", "X" + CHR$(253)
    FOR a = 0 TO CharBase - 1
      Search$ = NumS$(a)
      IF a > 9 THEN
        Search$ = CHR$(48 + a)
      END IF
      FOR b = 1 TO LEN(OutCome$)
        IF MID$(OutCome$, b, 1) = Search$ THEN Stats(a) = Stats(a) + 1
      NEXT b
      PRINT " "; Search$, Stats(a), INT((100 * Stats(a) / LEN(OutCome$)) * 100) / 100; "%", (((Stats(a) - (LEN(OutCome$) / 10)) ^ 2) / (LEN(OutCome$) / 10))
    NEXT a
    COLOR 15
    PRINT "Total: "; , LEN(OutCome$), " 100 %"
    COLOR 7
    PCOPY 1, 0
    LOCATE 25, 1: PRINT "Press any key to continue";
    DO: k$ = INKEY$: LOOP UNTIL LEN(k$)
    LOCATE , 1: PRINT "                         ": LOCATE , 1
    SCREEN , , 0, 0
  CASE 8                     'Options
    COLOR 14, 1
    LOCATE 2, 5
    PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    FOR a = 1 TO MenuCount
      LOCATE , 5
      PRINT "º                                             º"
    NEXT a
    LOCATE MenuCount + 3, 5
    PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
    DO
      Choice = SelectChoice(Options$(), 3, 6, 50, 15, 1, 0, 3)
      SELECT CASE Choice
      CASE 1
        SCREEN , , 1, 1
        LOCATE 24, 1
        COLOR 10, 0: PRINT "Enter base that will be used throughout the program"
        COLOR 7: PRINT "Base: ";
        COLOR 15: INPUT "", Num$
        COLOR 7
        a = VAL(Num$)
        IF a > 1 AND a < 36 THEN CharBase = a
        SCREEN , , 0, 0
      CASE 2
        SCREEN , , 1, 1
        LOCATE 24, 1
        COLOR 10, 0: PRINT "Enter filename to write results to (plain textfile). Press enter to turn it of"
        PRINT "Only powers, factorials, fibonacci's and the last prime will be saved."
        COLOR 7: PRINT "Filename: ";
        COLOR 15: INPUT "", File$
        COLOR 7
        IF File$ = "" THEN
          SaveResults = 0
          CLOSE #1
        END IF
        IF FREEFILE = 1 THEN
          SaveResults = -1
          OPEN File$ FOR APPEND AS #1
        END IF
        SCREEN , , 0, 0
      CASE 3
        SaveResults = 0
        File$ = ""
        CLOSE #1
      CASE 4, -1
        EXIT DO
      END SELECT
    LOOP
  CASE 9, -1          'Exit program, user pressed esc
    COLOR 7, 0
    PCOPY 1, 0
    LOCATE 25, 1
    END
  END SELECT
LOOP

Handler:                'Error handler to make sure program doesn't end after
RESUME NEXT             'a division by zero
'-Í=ð=Í-Í=ð=Í-Í=ð=Í-DEMO ENDS HERE-=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=

FUNCTION DMod# (Num1#, Num2#)
'A MOD function for DOUBLEs (QB's MOD works only for LONG ints)
DIM Multiples#(1 TO 9)
Multiples#(1) = Num2#
FOR a = 2 TO 9
  Multiples#(a) = Multiples#(a - 1) + Multiples#(1)
NEXT a
'OutNum# = 10^NumS$(LEN(Num1$) - LEN(Num2$) - 1))
'OutTest$ = StrSub$(Num1$, StrMul$(Num2$, OutNum$))
OutTest# = Num1#
FOR a = 9 TO 1 STEP -1
  DO UNTIL Multiples#(a) > OutTest#
    OutTest# = OutTest# - Multiples#(a)
    OutNum# = OutNum# + a
    IF OutTest# <= 0 THEN EXIT FOR
  LOOP
NEXT a
DMod# = OutTest#
END FUNCTION

FUNCTION DRE.Bin2Dec (Bit$)
'converts binary string to decimal equivalent
Temp& = 0
Length = LEN(Bit$)
FOR a = 1 TO Length
  IF MID$(Bit$, Length - a + 1, 1) = "1" THEN Temp& = Temp& + 2 ^ (a - 1)
NEXT a
IF Temp& > 32767 THEN
  DRE.Bin2Dec = Temp& - 65536
ELSE
  DRE.Bin2Dec = Temp&
END IF
END FUNCTION

FUNCTION DRE.Dec2Bin$ (Decimal)
'Returns binary string of 'Decimal'.
h$ = HEX$(Decimal)
FOR a = 1 TO LEN(h$)
  Digit = INSTR("0123456789ABCDEF", MID$(h$, a, 1)) - 1
  IF Digit < 0 THEN
    BinNum$ = ""
    EXIT FOR
  END IF
  b = 8
  c = 4
  DO
    BinNum$ = BinNum$ + RIGHT$(STR$((Digit \ b) MOD 2), 1)
    b = b - (b \ 2)
    c = c - 1
    IF c = 0 THEN EXIT DO
  LOOP WHILE b
NEXT a
DRE.Dec2Bin$ = BinNum$
END FUNCTION

FUNCTION DRE.Dec2Eng$ (Number)
'Currently capable of converting 1-3999 to english literal
DIM Literals$(10, 1 TO 4)
Literals$(0, 1) = "zero"
Literals$(1, 1) = "one"
Literals$(2, 1) = "two"
Literals$(3, 1) = "three"
Literals$(4, 1) = "four"
Literals$(5, 1) = "five"
Literals$(6, 1) = "six"
Literals$(7, 1) = "seven"
Literals$(8, 1) = "eight"
Literals$(9, 1) = "nine"

Literals$(1, 2) = "ten"
Literals$(2, 2) = "twenty"
Literals$(3, 2) = "thirty"
Literals$(4, 2) = "fourty"
Literals$(5, 2) = "fifty"
Literals$(6, 2) = "sixty"
Literals$(7, 2) = "seventy"
Literals$(8, 2) = "eighty"
Literals$(9, 2) = "ninety"

Literals$(1, 3) = "one hundred"
Literals$(2, 3) = "two hundred"
Literals$(3, 3) = "three hundred"
Literals$(4, 3) = "four hundred"
Literals$(5, 3) = "five hundred"
Literals$(6, 3) = "six hundred"
Literals$(7, 3) = "seven hundred"
Literals$(8, 3) = "eight hundred"
Literals$(9, 3) = "nine hundred"

Literals$(1, 4) = "thousand"
Literals$(2, 4) = "two thousand"
Literals$(3, 4) = "three thousand"
Literals$(4, 3) = "four thousand"
Literals$(5, 4) = "five thousand"
Literals$(6, 4) = "six thousand"
Literals$(7, 4) = "seven thousand"
Literals$(8, 4) = "eight thousand"
Literals$(9, 4) = "nine thousand"

n$ = NumS$(Number)
IF n$ = "0" THEN
  DRE.Dec2Eng$ = Literals$(0, 1)
END IF

IF LEN(n$) > 4 THEN n$ = LEFT$(n$, 4)

IF LEN(n$) > 1 THEN
  FOR a = 1 TO LEN(n$) - 2  'TO 1 STEP -1
    b = (LEN(n$) + 1) - a
    IF MID$(n$, a, 1) <> "0" THEN
      OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, a, 1)), b) + " "
    'ELSE
    '  IF a = 2 THEN OutCome$ = OutCome$ + "and "
    END IF
  NEXT a
  SELECT CASE RIGHT$(n$, 2)
  CASE "11"
    OutCome$ = OutCome$ + "eleven"
  CASE "12"
    OutCome$ = OutCome$ + "twelve"
  CASE "13"
    OutCome$ = OutCome$ + "thirteen"
  CASE "14"
    OutCome$ = OutCome$ + "fourteen"
  CASE "15"
    OutCome$ = OutCome$ + "fifteen"
  CASE "16"
    OutCome$ = OutCome$ + "sixteen"
  CASE "17"
    OutCome$ = OutCome$ + "seventeen"
  CASE "18"
    OutCome$ = OutCome$ + "eighteen"
  CASE "19"
    OutCome$ = OutCome$ + "nineteen"
  CASE ELSE
    IF MID$(n$, LEN(n$) - 1, 1) <> "0" THEN
      OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, LEN(n$) - 1, 1)), 2) + " "
    END IF
    IF MID$(n$, LEN(n$), 1) <> "0" THEN
      IF MID$(n$, LEN(n$) - 1, 1) = "0" THEN OutCome$ = OutCome$ + "and "
      OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, LEN(n$), 1)), 1) + " "
    END IF
  END SELECT
ELSE
  OutCome$ = OutCome$ + Literals$(VAL(n$), 1) + " "
END IF
DRE.Dec2Eng$ = RTRIM$(OutCome$)
END FUNCTION

FUNCTION DRE.Dec2Nl$ (Number)
'Currently capable of converting 1-3999 to dutch literal
DIM Literals$(0 TO 10, 1 TO 4)
Literals$(0, 1) = "nul"
Literals$(1, 1) = "een"
Literals$(2, 1) = "twee"
Literals$(3, 1) = "drie"
Literals$(4, 1) = "vier"
Literals$(5, 1) = "vijf"
Literals$(6, 1) = "zes"
Literals$(7, 1) = "zeven"
Literals$(8, 1) = "acht"
Literals$(9, 1) = "negen"

Literals$(1, 2) = "tien"
Literals$(2, 2) = "twintig"
Literals$(3, 2) = "dertig"
Literals$(4, 2) = "veertig"
Literals$(5, 2) = "vijftig"
Literals$(6, 2) = "zestig"
Literals$(7, 2) = "zeventig"
Literals$(8, 2) = "tachtig"
Literals$(9, 2) = "negentig"

Literals$(1, 3) = "honderd"
Literals$(2, 3) = "tweehonderd"
Literals$(3, 3) = "driehonderd"
Literals$(4, 3) = "vierhonderd"
Literals$(5, 3) = "vijfhonderd"
Literals$(6, 3) = "zeshonderd"
Literals$(7, 3) = "zevenhonderd"
Literals$(8, 3) = "achthonderd"
Literals$(9, 3) = "negenhonderd"

Literals$(1, 4) = "duizend"
Literals$(2, 4) = "tweeduizend"
Literals$(3, 4) = "drieduizend"
Literals$(4, 3) = "vierduizend"
Literals$(5, 4) = "vijfduizend"
Literals$(6, 4) = "zesduizend"
Literals$(7, 4) = "zevenduizend"
Literals$(8, 4) = "achtduizend"
Literals$(9, 4) = "negenduizend"

n$ = NumS$(Number)
SELECT CASE n$
CASE "11"
  DRE.Dec2Nl$ = "elf"
  EXIT FUNCTION
CASE "12"
  DRE.Dec2Nl$ = "twaalf"
  EXIT FUNCTION
CASE "13"
  DRE.Dec2Nl$ = "dertien"
  EXIT FUNCTION
CASE "14"
  DRE.Dec2Nl$ = "veertien"
  EXIT FUNCTION
CASE "15"
  DRE.Dec2Nl$ = "vijftien"
  EXIT FUNCTION
CASE "16"
  DRE.Dec2Nl$ = "zestien"
  EXIT FUNCTION
CASE "17"
  DRE.Dec2Nl$ = "zeventien"
  EXIT FUNCTION
CASE "18"
  DRE.Dec2Nl$ = "achtien"
  EXIT FUNCTION
CASE "19"
  DRE.Dec2Nl$ = "negentien"
  EXIT FUNCTION
CASE "0"
  DRE.Dec2Nl$ = Literals$(0, 1)
  EXIT FUNCTION
END SELECT

IF LEN(n$) > 4 THEN n$ = LEFT$(n$, 4)
IF LEN(n$) > 1 THEN
  FOR a = 1 TO LEN(n$) - 2 'TO 1 STEP -1
    b = (LEN(n$) + 1) - a
    IF MID$(n$, a, 1) <> "0" THEN OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, a, 1)), b) + " "
  NEXT a
  a = LEN(n$)
  b = (LEN(n$) + 1) - a
  IF MID$(n$, a, 1) <> "0" THEN OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, a, 1)), b) + "en"
  a = LEN(n$) - 1
  b = (LEN(n$) + 1) - a
  IF MID$(n$, a, 1) <> "0" THEN OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, a, 1)), b)
ELSE
  FOR a = 1 TO LEN(n$)   'TO 1 STEP -1
    b = (LEN(n$) + 1) - a
    IF MID$(n$, a, 1) <> "0" THEN OutCome$ = OutCome$ + Literals$(VAL(MID$(n$, a, 1)), b) + " "
  NEXT a
END IF
DRE.Dec2Nl$ = RTRIM$(OutCome$)
END FUNCTION

FUNCTION DRE.Dec2Rom$ (Number)
'Currently capable of converting 1-3999 to roman numeral
DIM Roman$(4), Halfes$(3)
Roman$(1) = "I"
Roman$(2) = "X"
Roman$(3) = "C"
Roman$(4) = "M"

Halfes$(1) = "V"
Halfes$(2) = "L"
Halfes$(3) = "D"

n$ = NumS$(Number)
IF LEN(n$) > 4 THEN n$ = LEFT$(n$, 4)
FOR a = 1 TO LEN(n$) 'TO 1 STEP -1
  b = (LEN(n$) + 1) - a
  SELECT CASE VAL(MID$(n$, a, 1))
  CASE 1
    OutCome$ = OutCome$ + Roman$(b)
  CASE 2
    OutCome$ = OutCome$ + Roman$(b) + Roman$(b)
  CASE 3
    OutCome$ = OutCome$ + Roman$(b) + Roman$(b) + Roman$(b)
  CASE 4
    OutCome$ = OutCome$ + Roman$(b) + Halfes$(b)
  CASE 5
    OutCome$ = OutCome$ + Halfes$(b)
  CASE 6
    OutCome$ = OutCome$ + Halfes$(b) + Roman$(b)
  CASE 7
    OutCome$ = OutCome$ + Halfes$(b) + Roman$(b) + Roman$(b)
  CASE 8
    OutCome$ = OutCome$ + Halfes$(b) + Roman$(b) + Roman$(b) + Roman$(b)
  CASE 9
    OutCome$ = OutCome$ + Roman$(b) + Roman$(b + 1)
  END SELECT
NEXT a
DRE.Dec2Rom$ = OutCome$
END FUNCTION

FUNCTION DRE.Rom2Dec (Roman$)
'Can handle a maximum of 20 roman digits ranging from I to M
'NO error checking is done so you could also convert VM or IC for example.
DIM OutCome(20)
Rom$ = UCASE$(Roman$)
FOR a = 1 TO LEN(Rom$)
  SELECT CASE MID$(Rom$, a, 1)
  CASE "I"
    OutCome(a) = 1
  CASE "X"
    OutCome(a) = 10
  CASE "C"
    OutCome(a) = 100
  CASE "M"
    OutCome(a) = 1000
  CASE "V"
    OutCome(a) = 5
  CASE "L"
    OutCome(a) = 50
  CASE "D"
    OutCome(a) = 500
  END SELECT
NEXT a
FOR a = 1 TO LEN(Rom$)
  IF OutCome(a) < OutCome(a + 1) OR OutCome(a) < OutCome(a + 2) THEN
    Final = Final - OutCome(a)
  ELSE
    Final = Final + OutCome(a)
  END IF
NEXT a
DRE.Rom2Dec = Final
END FUNCTION

FUNCTION Factorial# (Num)
'Calculate faculty without recursion
IF Num = 0 OR Num = 1 THEN
  Factorial# = 1
  EXIT FUNCTION
END IF
b# = 1
FOR a = 2 TO Num
  b# = b# * a
NEXT a
Factorial# = b#
END FUNCTION

FUNCTION FCol$ (FG)
COLOR FG
END FUNCTION

FUNCTION IsPrime (Num$)
'As the name suggests, this FUNCTION tests if number is a prime

IF INSTR("024568", RIGHT$(Num$, 1)) THEN EXIT FUNCTION   'Number is even and/or divideble by 5

FOR a = 1 TO LEN(Num$)
  Test& = Test& + VAL(MID$(Num$, a, 1))
NEXT a
IF Test& MOD 3 = 0 THEN EXIT FUNCTION                   'Number has divisor 3

IF LEN(Num$) > 8 THEN '16
  a$ = "1"
  b$ = StrSqr$(Num$)
  DO
    IF StrMod$(a$, "3") <> "0" THEN
      IF StrMod$(Num$, a$) = "0" THEN EXIT FUNCTION
    END IF
    a$ = StrAdd$(a$, "2")
  LOOP UNTIL StrGreater(a$, b$)
ELSE
  Number# = VAL(Num$)
  FOR a# = 5 TO INT(SQR(Number#)) STEP 2
    IF Number# MOD a# = 0 THEN EXIT FUNCTION
  NEXT a#
END IF
IsPrime = -1                                             'We have a winner!
END FUNCTION

FUNCTION IsPrimeD (Num#)
'As the name suggests, this FUNCTION tests if number is a prime
'The D stands for DOUBLE

'IF Num# AND 1 = 0 THEN EXIT FUNCTION    'Number is even

FOR a# = 3 TO INT(SQR(Num#)) STEP 2
  IF Num# MOD a# = 0 THEN EXIT FUNCTION
  'IF DMod#(Num#, a#) = 0 THEN EXIT FUNCTION
NEXT a#
IsPrimeD = -1                                             'We have a winner!
END FUNCTION

FUNCTION Max (Num1, Num2)
IF Num1 > Num2 THEN Max = Num1 ELSE Max = Num2
END FUNCTION

FUNCTION Min (Num1, Num2)
IF Num1 < Num2 THEN Min = Num1 ELSE Min = Num2
END FUNCTION

SUB NumPrint (Num$, CharsPerColumn)
'Prints a StringNumber in nice format (5-char columns)

IF BCDMethod = -1 THEN
  FOR a = 1 TO LEN(Num$)
    PRINT NumS$(ASC(MID$(Num$, a, 1))) + " ";
  NEXT a
  EXIT SUB
END IF

a = POS(0)
IF a > 1 THEN
  WHILE a MOD (CharsPerColumn + 1) > 0
    a = a + 1
  WEND
  LOCATE , a + 1
END IF
FOR a = 0 TO LEN(Num$) \ CharsPerColumn
  IF CharBase < 11 THEN
    PRINT MID$(Num$, a * CharsPerColumn + 1, CharsPerColumn); " ";
  ELSE
    b$ = ""
    FOR b = 1 TO CharsPerColumn
      a$ = MID$(Num$, a * CharsPerColumn + b, 1)
      IF ASC(a$ + " ") < 58 THEN
        b$ = b$ + a$
      ELSE
        b$ = b$ + CHR$(ASC(a$ + " ") + 7)
      END IF
    NEXT b
    PRINT b$; " ";
  END IF
NEXT a
PRINT
END SUB

FUNCTION NumS$ (Num)
'Shortcut to convert number to string
NumS$ = LTRIM$(STR$(Num))
END FUNCTION

SUB NumTrim (Num$)
'Delete excess of spaces and zero's from string number
IF LEFT$(Num$, 1) <> "0" AND INSTR(Num$, " ") = 0 THEN EXIT SUB
Num$ = LTRIM$(Num$)
IF Num$ = STRING$(LEN(Num$), "0") THEN
  Num$ = "0"
  EXIT SUB
END IF
FOR a = 1 TO LEN(Num$)
  IF MID$(Num$, a, 1) <> "0" THEN EXIT FOR
NEXT a
Num$ = MID$(Num$, a)
Num$ = RTRIM$(Num$)
END SUB

SUB PokeChar (Char, Fore, Back)
'Write character directly to memory. Faster than PRINT
DEF SEG = 0
CWidth = PEEK(&H44A)
IF PEEK(&H449) = 7 THEN
  DEF SEG = &HA000
ELSE
  DEF SEG = &HB800
END IF
POKE ((CSRLIN - 1) * CWidth + (POS(0) - 1)) + ((CSRLIN - 1) * CWidth + (POS(0) - 1)), Char
POKE ((CSRLIN - 1) * CWidth + (POS(0) - 1)) + ((CSRLIN - 1) * CWidth + (POS(0) - 1)) + 1, (Back * 16) + Fore
DEF SEG
END SUB

SUB ReColor (Y1, X1, Y2, X2, Fore, Back)
'Changes fore/back colors in given area of screen.
ReplaceAtt = (Back * 16) + Fore
DEF SEG = 0
CWidth = PEEK(&H44A)
IF PEEK(&H449) = 7 THEN
  DEF SEG = &HA000
ELSE
  DEF SEG = &HB800
END IF
IF X2 > CWidth THEN X2 = CWidth
FOR Row = Y1 - 1 TO Y2 - 1
  FOR Col = X1 - 1 TO X2 - 1
    POKE (Row * CWidth + Col) + (Row * CWidth + Col) + 1, ReplaceAtt
  NEXT Col
NEXT Row
DEF SEG
END SUB

FUNCTION SelectChoice (Choices$(), Y1, X1, X2, TextFore, TextBack, SelFore, SelBack)
'User can select from list of choices with up and down keys
FOR MaxIndex = LBOUND(Choices$) TO UBOUND(Choices$)
  IF Choices$(MaxIndex) = "" THEN
    MaxIndex = MaxIndex - 1
    EXIT FOR
  END IF
NEXT MaxIndex
Y2 = Y1 + MaxIndex - LBOUND(Choices$)

COLOR TextFore, TextBack
FOR a = LBOUND(Choices$) TO MaxIndex
  LOCATE (a - 1) + Y1, X1
  PRINT Choices$(a)
NEXT a
Selected = Y1
DO
  ReColor Selected, X1, Selected, X2, SelFore, SelBack
  DO
    k$ = INKEY$
  LOOP UNTIL LEN(k$)
  SELECT CASE ASC(RIGHT$(k$, 1))
  CASE 27
    SelectChoice = -1
    EXIT FUNCTION
  CASE 13
    EXIT DO
  CASE 72
    ReColor Selected, X1, Selected, X2, TextFore, TextBack
    IF Selected = Y1 THEN Selected = Y2
    Selected = Selected + (Selected > Y1)
  CASE 80
    ReColor Selected, X1, Selected, X2, TextFore, TextBack
    IF Selected = Y2 - 1 THEN Selected = Y1 - 1
    Selected = Selected - (Selected < Y2 - 1)
  END SELECT
LOOP
SelectChoice = 1 + Selected - Y1
END FUNCTION

FUNCTION StrAdd$ (Num1$, Num2$)
'NumTrim Num1$
'NumTrim Num2$
IF Num1$ = "" OR Num1$ = "0" THEN
  StrAdd$ = Num2$
  EXIT FUNCTION
ELSEIF Num2$ = "" OR Num2$ = "0" THEN
  StrAdd$ = Num1$
  EXIT FUNCTION
END IF
IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) <> SignChar THEN      ' -a + b = b -a
  StrAdd$ = StrSub$(Num2$, MID$(Num1$, 2))
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> SignChar AND LEFT$(Num2$, 1) = SignChar THEN      ' a + -b = b - a
  StrAdd$ = SignChar + StrSub$(MID$(Num2$, 2), Num1$)
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) = SignChar THEN       ' -a + -b = -(a+b)
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = -1
  Sign$ = SignChar
END IF
IF LEN(Num1$) < LEN(Num2$) THEN
  OutNum$ = STRING$(LEN(Num2$) - LEN(Num1$), StartingChar) + Num2$
  Num1$ = STRING$(2 * (LEN(Num2$) - LEN(Num1$)), StartingChar) + Num1$
ELSE
  Swapped = -1
  SWAP Num1$, Num2$
  Num1$ = STRING$(LEN(Num2$) - LEN(Num1$) + 1, StartingChar) + Num1$
  OutNum$ = CHR$(StartingChar) + Num2$
END IF
FOR a = LEN(Num1$) TO 1 STEP -1
  OutCome = (ASC(MID$(Num1$, a, 1)) - StartingChar) + (ASC(MID$(OutNum$, a, 1)) - StartingChar) + Keep
  Keep = OutCome \ CharBase              'the excess
  OutCome = OutCome MOD CharBase         'the rest
  'IF OutCome >= 0 AND OutCome <= CharBase - 1 THEN
  MID$(OutNum$, a, 1) = CHR$(OutCome + StartingChar)
NEXT a
IF Keep > 0 THEN
   OutNum$ = CHR$(Keep + StartingChar) + OutNum$
END IF
IF Swapped THEN SWAP Num1$, Num2$
IF SignDel THEN
  Num1$ = SignChar + Num1$
  Num2$ = SignChar + Num2$
END IF
NumTrim OutNum$
StrAdd$ = Sign$ + OutNum$
END FUNCTION

FUNCTION StrComb$ (Num1$, Num2$)
'Uses combination formula to calculate number of combinations
'  e.g. how many different 4-member groups can be made of a group of 10 things
'   = StrComb$("10","4") [answer: 210]
'note: first number must be => second number
'formula:       n!
'           ÄÄÄÄÄÄÄÄÄÄ
'           r!(n - r)!
StrComb$ = StrDiv$(StrFac$(Num1$), StrMul$(StrFac$(Num2$), StrFac$(StrSub$(Num1$, Num2$))))
END FUNCTION

FUNCTION StrDiv$ (Num1$, Num2$)
'Perform integer division
DIM Multiples$(1 TO 9)

'NumTrim Num1$
'NumTrim Num2$
IF Num2$ = "0" THEN                          'Division by zero....
  StrDiv$ = "-E-"
  EXIT FUNCTION
END IF
IF Num1$ = Num2$ THEN                        'Division by itself....
  StrDiv$ = "1"
  EXIT FUNCTION
END IF

IF Num2$ = "1" THEN                          'Division by one
  StrDiv$ = Num1$
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) <> SignChar THEN    ' -a * b = -(a * b)
  Sign$ = SignChar
  Num1$ = MID$(Num1$, 2)
  SignDel = 1
END IF

IF LEFT$(Num2$, 1) = SignChar AND LEFT$(Num1$, 1) <> SignChar THEN    ' a * -b = -(a * b)
  Sign$ = SignChar
  Num2$ = MID$(Num2$, 2)
  SignDel = 2
END IF

IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) = SignChar THEN    ' -a * -b = a * b
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = 3
END IF

IF StrSmaller(Num1$, Num2$) THEN             'This is an integer division!
  StrDiv$ = CHR$(StartingChar)
  EXIT FUNCTION
END IF
Multiples$(1) = Num2$
FOR a = 2 TO 9
  Multiples$(a) = StrAdd$(Multiples$(a - 1), Multiples$(1))
NEXT a
Multiples$(1) = Num2$
OutNum$ = StrPwr$(NumS$(CharBase), NumS$(LEN(Num1$) - LEN(Num2$) - 1))
OutTest$ = StrSub$(Num1$, StrMul$(Num2$, OutNum$))

'Old method
'DO
'  OutTest$ = StrSub$(OutTest$, Num2$)
'  IF OutTest$ = "0" OR LEFT$(OutTest$, 1) = SignChar THEN EXIT DO
'  OutNum$ = StrAdd$(OutNum$, "1")
'LOOP

'New method
FOR a = 9 TO 1 STEP -1
  DO UNTIL StrGreater(Multiples$(a), OutTest$)
    OutTest$ = StrSub$(OutTest$, Multiples$(a))
    OutNum$ = StrAdd$(OutNum$, NumS$(a))
    IF OutTest$ = "0" OR LEFT$(OutTest$, 1) = SignChar THEN EXIT FOR
  LOOP
NEXT a

'Clean up and return value
SELECT CASE SignDel
CASE 1
  Num1$ = SignChar + Num1$
CASE 2
  Num2$ = SignChar + Num2$
CASE 3
  Num1$ = SignChar + Num1$
  Num2$ = SignChar + Num2$
END SELECT
StrDiv$ = Sign$ + OutNum$
END FUNCTION

FUNCTION StrFac$ (Fac$)
'Returns faculty of Fac

'NumTrim Fac$
IF StrSmaller(Fac$, CHR$(StartingChar)) THEN EXIT FUNCTION
IF Fac$ = "" OR Fac$ = "1" THEN
  StrFac$ = "1"
  EXIT FUNCTION
END IF
OutCome$ = "1"
p = POS(0) + 9
Counter$ = "2"
IF LEN(Fac$) < 17 THEN
  Fac# = VAL(Fac$)                   'This method is WAY faster...
  FOR a# = 2 TO Fac#
    OutCome$ = StrMul$(OutCome$, LTRIM$(STR$(a#)))
  NEXT a#
ELSE
  DO
    OutCome$ = StrMul$(OutCome$, Counter$)
    Counter$ = StrAdd$(Counter$, "1")
  LOOP UNTIL Counter$ = StrAdd$(Fac$, "1")
END IF
NumTrim OutCome$
StrFac$ = OutCome$
END FUNCTION

FUNCTION StrFib$ (Num$)
IF Num$ = "1" THEN                  'These have been defined
  StrFib$ = "1"
  EXIT FUNCTION
ELSEIF Num$ = "2" THEN              ' "     "     "     "
  StrFib$ = "1"
  EXIT FUNCTION
ELSEIF Num$ = "3" THEN              ' "     "     "     "
  StrFib$ = "2"
  EXIT FUNCTION
END IF
PassOne$ = "1"
PassTwo$ = "2"
IF LEN(Num$) < 5 THEN
  Num = VAL(Num$)
  FOR a = 1 TO Num - 3
    OutCome$ = StrAdd$(PassOne$, PassTwo$)
    PassOne$ = PassTwo$
    PassTwo$ = OutCome$
  NEXT a
ELSE
  FOR a = 1 TO 9999
    OutCome$ = StrAdd$(PassOne$, PassTwo$)
    PassOne$ = PassTwo$
    PassTwo$ = OutCome$
  NEXT a
  ToNum$ = StrSub$(Num$, "9999")
  DO
    ToNum$ = StrSub$(Num$, "1")
    OutCome$ = StrAdd$(PassOne$, PassTwo$)
    PassOne$ = PassTwo$
    PassTwo$ = OutCome$
  LOOP UNTIL ToNum$ = "2"
END IF
StrFib$ = OutCome$
END FUNCTION

FUNCTION StrGreater (Num1$, Num2$)
'Returns true if Num1$ is greater than Num2$

NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) <> SignChar THEN      ' -a + b = b -a
  StrGreater = 0
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> SignChar AND LEFT$(Num2$, 1) = SignChar THEN      ' a + -b = b - a
  StrGreater = -1
  EXIT FUNCTION
END IF

IF Num1$ = Num2$ THEN
  StrGreater = 0
  EXIT FUNCTION                             'Useless to test
ELSEIF LEN(Num1$) > LEN(Num2$) THEN         'Also
  StrGreater = -1
  EXIT FUNCTION
ELSEIF LEN(Num1$) < LEN(Num2$) THEN         'Also
  StrGreater = 0
  EXIT FUNCTION
ELSEIF LEN(Num1$) = LEN(Num2$) THEN         'Here begins the real work
  FOR a = 1 TO LEN(Num1$)
    IF ASC(MID$(Num1$, a, 1)) > ASC(MID$(Num2$, a, 1)) THEN
      StrGreater = -1
      EXIT FUNCTION
    ELSEIF ASC(MID$(Num1$, a, 1)) < ASC(MID$(Num2$, a, 1)) THEN
      StrGreater = 0
      EXIT FUNCTION
    END IF
  NEXT a
END IF
'Program shouldn't reach this point.
END FUNCTION

FUNCTION StrMod$ (Num1$, Num2$)
'Modulus (remainder of an integer division)

'NumTrim Num1$
'NumTrim Num2$
IF Num2$ = "" THEN EXIT FUNCTION             'Division by zero....
IF Num2$ = "1" THEN                          'Division by one
  StrMod$ = CHR$(StartingChar)
  EXIT FUNCTION
END IF
IF Num2$ = Num1$ THEN                        'Division by itself
  StrMod$ = CHR$(StartingChar)
  EXIT FUNCTION
END IF
IF StrSmaller(Num1$, Num2$) THEN             'Faster
  StrMod$ = Num1$
  EXIT FUNCTION
END IF
'VERY inefficient but I needed something that worked....
StrMod$ = StrSub$(Num1$, StrMul$(StrDiv$(Num1$, Num2$), Num2$))
END FUNCTION

FUNCTION StrMul$ (Num1$, Num2$)
DIM Keep                'Holds values to be transported to next digit
DIM OutNum$             'Holds the result
DIM OutStep$            'Holds eaqch step of the result

'NumTrim Num1$
'NumTrim Num2$
IF Num1$ = "" OR Num2$ = "" THEN EXIT FUNCTION          'Zero...

IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) <> SignChar THEN    ' -a * b = -(a * b)
  Sign$ = SignChar
  Num1$ = MID$(Num1$, 2)
  SignDel = 1
END IF

IF LEFT$(Num2$, 1) = SignChar AND LEFT$(Num1$, 1) <> SignChar THEN    ' a * -b = -(a * b)
  Sign$ = SignChar
  Num2$ = MID$(Num2$, 2)
  SignDel = 2
END IF

IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) = SignChar THEN    ' -a * -b = a * b
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = 3
END IF

FOR a = LEN(Num2$) TO 1 STEP -1
  OutStep$ = STRING$(LEN(Num1$) + LEN(Num2$), StartingChar)
  FOR b = LEN(Num1$) TO 1 STEP -1
    OutCome = (ASC(MID$(Num1$, b, 1)) - StartingChar) * (ASC(MID$(Num2$, a, 1)) - StartingChar) + Keep
    IF OutCome > CharBase - 1 THEN
      Keep = OutCome \ CharBase             'the excess
      OutCome = OutCome MOD CharBase        'the rest
    ELSE
      Keep = 0
    END IF
    'IF OutCome >= 0 AND OutCome < CharBase THEN
    MID$(OutStep$, b + a, 1) = CHR$(OutCome + StartingChar)
  NEXT b
  IF Keep THEN
    MID$(OutStep$, b + a, 1) = CHR$(Keep + StartingChar)
    Keep = 0
  END IF
  OutNum$ = StrAdd$(OutNum$, OutStep$)
NEXT a
NumTrim OutNum$
SELECT CASE SignDel
CASE 1
  Num1$ = SignChar + Num1$
CASE 2
  Num2$ = SignChar + Num2$
CASE 3
  Num1$ = SignChar + Num1$
  Num2$ = SignChar + Num2$
END SELECT
StrMul$ = Sign$ + OutNum$
END FUNCTION

FUNCTION StrPerm$ (Num1$, Num2$)
'Uses permutation formula to calculate number of permutations
'  e.g. how many different 4-digit values can be made of numbers 1 through 7
'   = StrPerm$("7","4") [answer: 840]
'note: first number must be => second number
'formula:      n!
'           ÄÄÄÄÄÄÄÄ
'           (n - r)!
StrPerm$ = StrDiv$(StrFac$(Num1$), StrFac$(StrSub$(Num1$, Num2$)))
END FUNCTION

FUNCTION StrPwr$ (Num1$, Num2$)
'Raise Num1$ to the power of Num2$. You can only raise to an integer power
'higher than zero.
TempNum$ = Num2$
OutCome$ = "1"

'NumTrim Num1$
'NumTrim Num2$
IF LEFT$(Num1$, 1) = SignChar THEN
  'IF INSTR("13579", RIGHT$(Num2$, 1)) THEN Sign$ = SignChar
  IF ASC(RIGHT$(Num2$, 1)) AND 1 THEN Sign$ = SignChar
END IF
IF LEFT$(Num2$, 1) = SignChar THEN EXIT FUNCTION  'This is an integer library!...
IF Num2$ = CHR$(StartingChar) THEN
  StrPwr$ = "1"
  EXIT FUNCTION
ELSEIF Num2$ = "1" THEN
  StrPwr$ = Num1$
  EXIT FUNCTION
END IF
DO
  TempNum$ = StrSub$(TempNum$, "1")
  OutCome$ = StrMul$(OutCome$, Num1$)
LOOP UNTIL TempNum$ = CHR$(StartingChar)
IF LEFT$(OutCome$, 1) = SignChar THEN Sign$ = ""
StrPwr$ = Sign$ + OutCome$
END FUNCTION

FUNCTION StrSmaller (Num1$, Num2$)
'Returns true if Num1$ is smaller than Num2$

NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) <> SignChar THEN      ' -a + b = b -a
  StrSmaller = -1
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> SignChar AND LEFT$(Num2$, 1) = SignChar THEN      ' a + -b = b - a
  StrSmaller = 0
  EXIT FUNCTION
END IF

IF Num1$ = Num2$ THEN
  EXIT FUNCTION                             'Useless to test
ELSEIF LEN(Num1$) > LEN(Num2$) THEN         'Also
  StrSmaller = 0
  EXIT FUNCTION
ELSEIF LEN(Num1$) < LEN(Num2$) THEN         'Also
  StrSmaller = -1
  EXIT FUNCTION
ELSEIF LEN(Num1$) = LEN(Num2$) THEN         'Here begins the real work
  FOR a = 1 TO LEN(Num1$)
    IF ASC(MID$(Num1$, a, 1)) < ASC(MID$(Num2$, a, 1)) THEN
      StrSmaller = -1
      EXIT FUNCTION
    ELSEIF ASC(MID$(Num1$, a, 1)) > ASC(MID$(Num2$, a, 1)) THEN
      StrSmaller = 0
      EXIT FUNCTION
    END IF
  NEXT a
END IF
'Program shouldn't reach this point.
END FUNCTION

FUNCTION StrSqr$ (Num$)
'Will calculate square root using Newtons iterative method:
'Try = 1
'DO
'  Test = Try - (Try ^ 2 - Root) / (Try * 2)
'  IF Test = Try THEN EXIT DO
'  Try = Test
'LOOP

IF LEFT$(Num$, 1) = SignChar THEN EXIT FUNCTION
OutNum$ = "1"
DO
  d$ = StrMul$(OutNum$, "2")             'OutNum$ * 2
  c$ = StrPwr$(OutNum$, "2")             'OutNum$ ^ 2
  b$ = StrSub$(c$, Num$)                 'OutNum$ ^ 2 - Num$
  a$ = StrDiv$(b$, d$) '**not working**  'OutNum$ ^ 2 - Num$ / OutNum$ * 2
  'a$ = NumS$(VAL(b$) \ VAL(d$))
  OutTest$ = StrSub$(OutNum$, a$)        'OutNum$ - (OutNum$ ^ 2 - Num$) / (OutNum$ * 2)
  IF OutNum$ = OutTest$ THEN EXIT DO
  OutNum$ = OutTest$
LOOP
StrSqr$ = StrSub$(OutNum$, "1")
EXIT FUNCTION

'not working but efficient part...
     AAA$ = Num$
     ZZ = LEN(AAA$)
     YY = (ZZ MOD 2) + 3
     AA = VAL(LEFT$(AAA$, (YY - 1)))
     VV = 10
     DO WHILE (VV * VV) > AA
       VV = VV - 1
     LOOP
     U$ = NumS$(VV)
     PP$ = NumS$(AA - (VV * VV)):

'    +++++++    iterative stuph   ++++++++++++++++++++++++++++++++++++

DO
     IF YY > ZZ THEN EXIT DO
     PP$ = PP$ + MID$(AAA$, YY, 2): YY = YY + 2
     TT$ = StrAdd$(UU$, UU$) + "0"
     SS$ = StrDiv$(PP$, TT$)
O08:
     VV$ = StrAdd$(TT$, SS$)
     QQ$ = StrMul$(VV$, SS$)
     IF StrSmaller(PP$, QQ$) THEN
       SS$ = StrSub$(SS$, "1")
       GOTO O08
     END IF
     UU$ = UU$ + SS$
     PP$ = StrSub(Num$, BB$)
LOOP
'    +++++   alldone: clean up, turn lights off, lock up   +++++++++

O12:
  Num$ = AAA$
  StrSqr$ = PP$  'CC$
  'WRITE "PP: ", PP$
  'WRITE "TT: ", TT$
  'WRITE "QQ: ", QQ$
  'WRITE "SS: ", SS$
  'WRITE "UU: ", UU$
  'WRITE "TT: ", TT$
  'WRITE "VV: ", VV$
END FUNCTION

FUNCTION StrSub$ (Num1$, Num2$)
DIM Keep                'Holds values to be transported to next digit
DIM OutNum$             'Holds the result
'NumTrim Num1$
'NumTrim Num2$
IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) <> SignChar THEN      ' -a - b = -(a + b)
  StrSub$ = SignChar + StrAdd$(Num2$, MID$(Num1$, 2))
  EXIT FUNCTION
END IF
IF LEFT$(Num1$, 1) <> SignChar AND LEFT$(Num2$, 1) = SignChar THEN      ' a - -b = a + -(b)
  StrSub$ = StrAdd$(MID$(Num2$, 2), Num1$)
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) = SignChar AND LEFT$(Num2$, 1) = SignChar THEN       ' -a - -b = -(b - a)
  SWAP Num1$, Num2$
  Swapped = -1
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = -1
END IF
IF Num1$ = "" THEN
  StrSub$ = SignChar + Num2$
  EXIT FUNCTION
END IF
IF Num2$ = "" THEN
  StrSub$ = Num1$
  EXIT FUNCTION
END IF
IF Num1$ = Num2$ THEN
  StrSub$ = CHR$(StartingChar)
  IF SingDel THEN
    Num1$ = SignChar + Num1$
    Num2$ = SignChar + Num2$
  END IF
  EXIT FUNCTION
END IF
IF StrGreater(Num2$, Num1$) THEN
  Sign$ = SignChar
  Swapped = NOT Swapped
  SWAP Num1$, Num2$
END IF
IF LEN(Num1$) < LEN(Num2$) THEN
  Num1$ = STRING$(LEN(Num2$) - LEN(Num1$) + 1, StartingChar) + Num1$
  OutNum$ = CHR$(StartingChar) + Num2$
ELSEIF LEN(Num1$) > LEN(Num2$) THEN
  OutNum$ = STRING$(LEN(Num1$) - LEN(Num2$) + 1, StartingChar) + Num2$
  Num1$ = CHR$(StartingChar) + Num1$
ELSE
  OutNum$ = Num2$
END IF
FOR a = LEN(Num1$) TO 1 STEP -1
  OutCome = (ASC(MID$(Num1$, a, 1)) - StartingChar) - (ASC(MID$(OutNum$, a, 1)) - StartingChar) - Keep
  IF OutCome < 0 THEN
    OutCome = (CharBase + (ASC(MID$(Num1$, a, 1)) - StartingChar)) - (ASC(MID$(OutNum$, a, 1)) - StartingChar) - Keep
    Keep = -(OutCome \ CharBase) + 1                              'the excess
  ELSEIF OutCome > CharBase - 1 THEN
    'stop
  ELSE
    Keep = 0
  END IF
  IF OutCome >= 0 AND OutCome <= CharBase - 1 THEN MID$(OutNum$, a, 1) = CHR$(OutCome + StartingChar)
NEXT a
NumTrim OutNum$
IF Swapped THEN SWAP Num1$, Num2$
IF SignDel THEN
  Num1$ = SignChar + Num1$
  Num2$ = SignChar + Num2$
END IF
StrSub$ = Sign$ + OutNum$
END FUNCTION

SUB TestSub
t! = TIMER
a$ = StrDiv$("123456789", "123")
t! = TIMER - t!
PRINT "It took"; t!; "seconds"
PRINT "Outcome: "; a$
END SUB