'===========================================================================
' Subject: COMMAND LINE BASE CONVERSION       Date: 04-10-00 (11:22)       
'  Author: Andreas van Cranenburgh            Code: QB, QBasic, PDS        
'  Origin: andreaswolf@mail.com             Packet: BINARY.ABC
'===========================================================================
'Handy command line base conversion tool  By Andreas van Cranenburgh (C) 2000
'    Mail any suggestions and bug reports to andreaswolf@mail.com
DECLARE FUNCTION DRE.Bin2Dec% (Bit$)
DECLARE SUB PokeChar (Char%, Fore%, Back%)
DECLARE FUNCTION DRE.Dec2Bin$ (Decimal%)
DECLARE FUNCTION Col$ (FG%)
DEFINT A-Z
DECLARE FUNCTION DRE.Dec2Nl$ (Number)
DECLARE FUNCTION DRE.Dec2Eng$ (Number)
DECLARE FUNCTION DRE.Dec2Rom$ (Number)
DECLARE FUNCTION DRE.Rom2Dec (Roman$)
IF INSTR(COMMAND$, "?") OR INSTR(COMMAND$, "HELP") THEN
  PRINT "Num - by Andreas van Cranenburgh"
  PRINT "Num is a simple yet handy tool to quickly convert a number to a variety"
  PRINT "of bases."
  PRINT "Options:     NUM 101 = print info about decimal 101"
  PRINT "             NUM &H1A1 = convert from hexadecimal 1A1"
  PRINT "             NUM &O766 = convert from octal number 766"
  PRINT "             NUM &B101 = convert from binary number 101"
  PRINT "             NUM &RMCM = convert from roman MCM (maximum 3999)"
  PRINT "             NUM &Cº = convert from ascii character º (maximum 255)"
END IF
IF LEFT$(COMMAND$, 2) = "&R" THEN
  a = DRE.Rom2Dec(MID$(COMMAND$, 3))
ELSEIF LEFT$(COMMAND$, 2) = "&B" THEN
  a = DRE.Bin2Dec(MID$(COMMAND$, 3))
ELSEIF LEFT$(COMMAND$, 2) = "&C" THEN
  a = ASC(MID$(COMMAND$, 3))
ELSE
  a = VAL(COMMAND$)
END IF
IF ABS(a) <> a THEN
  a = ABS(a)
  M$ = "-"
END IF
PRINT Col$(15); "DEC: "; Col$(7); M$; LTRIM$(STR$(a));
PRINT Col$(15); " HEX: "; Col$(7); M$; HEX$(a);
PRINT Col$(15); " OCT: "; Col$(7); M$; OCT$(a);
PRINT Col$(15); " BIN: "; Col$(7); M$; DRE.Dec2Bin$(a);
IF a < 4000 AND a >= 0 THEN PRINT Col$(15); " ROM: "; M$; Col$(7); DRE.Dec2Rom$(a);
IF a < 256 AND a >= 0 AND M$ = "" THEN
  PRINT Col$(15); " CHR: ";
  PokeChar a, 7, 0
  LOCATE , POS(0) - (POS(0) < 80)
END IF
IF M$ <> "" THEN M$ = "minus "
PRINT Col$(15); " ENG: "; Col$(7); M$; DRE.Dec2Eng$(a);

END

FOR a = 0 TO 20
  PRINT DRE.Dec2Eng$(a), DRE.Dec2Nl$(a), DRE.Dec2Rom$(a), HEX$(a), OCT$(a)
NEXT a

FUNCTION Col$ (FG)
COLOR FG
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 I = 1 TO LEN(h$)
  Digit = INSTR("0123456789ABCDEF", MID$(h$, I, 1)) - 1
  IF Digit < 0 THEN
    BinNum$ = ""
    EXIT FOR
  END IF
  J = 8
  k = 4
  DO
    BinNum$ = BinNum$ + RIGHT$(STR$((Digit \ J) MOD 2), 1)
    J = J - (J \ 2)
    k = k - 1
    IF k = 0 THEN EXIT DO
  LOOP WHILE J
NEXT I
DRE.Dec2Bin$ = BinNum$
END FUNCTION

FUNCTION DRE.Dec2Eng$ (Number)
'Currently capable of converting 1-3999 to english literal
DIM Literals$(10, 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$ = LTRIM$(STR$(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$(10, 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) = "twee duizend"
Literals$(3, 4) = "drie duizend"
Literals$(4, 3) = "vier duizend"
Literals$(5, 4) = "vijf duizend"
Literals$(6, 4) = "zes duizend"
Literals$(7, 4) = "zeven duizend"
Literals$(8, 4) = "acht duizend"
Literals$(9, 4) = "negen duizend"

n$ = LTRIM$(STR$(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$ = LTRIM$(STR$(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

SUB PokeChar (Char, Fore, Back)
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