!* Filename: CVT.BAS Date: 10/29/90

!**************************** AMUS Program Label ******************************
!* Filename: CVT.BAS Date: 10/29/90
!* Category: UTIL Hash Code: Version: 2.0(0)
!* Initials: HIS/LTD Name: John Paiement
!* Company: Holidair Insurance Services, Ltd. Telephone #: 6044124047
!* Related Files: CVT.PNT, CVT.HLP
!* Min. Op. Sys.: Expertise Level: BEG
!* Special: d/BASIC 1.1 required to compile and run this utility
!* Description: This revision of CVT.BAS is a full function calculator, with
!* memory functions. Also, it now supports values entered as a PPN for
!* conversion.
!***************************************************************************
!* NOTE: d/BASIC 1.1 required to compile & run this utility. CVT.HLP file
!* must go in the HLP: account
!*
!* Usage: The numeric base to be input is selected from a bar.input
!* so to enter a Hex number you would press 'H' then input the
!* numeric value. If the value of any input is greater than
!* FFFFh, the RAD50 and BINARY values are not displayed.
!*
!* The function keys around the keypad are how you select the
!* Mathematical/logical operations for the calculator. Logical
!* NOT will display the NOT(val entered) with no accumulation.
!*
!******************************************************************************

program CVT,2.0(0)

map1 G1$, S,30
map1 G2$, S,30
map1 G1, F
map1 G2, F
map1 X, F

function inkey$()
return ucs(chr(getkey(not(.keypress))))
endfunc

function valinp(G1$)

G2$ = "DHORBP" + chr(13) + chr(45) + chr(44) + "Q"+ chr(168) + chr(169) + chr(160) + chr(161) + chr(164) + chr(167) + chr(165) + chr(166) + chr(128) + chr(129) + chr(130) + chr(173)
G1 = instr(1,G2$,G1$)

G2 = G1 <> 0

return G2

endfunc

map1 FLT, F
map1 OPT, F
map1 DGT, F
map1 OP'SAV, F
map1 M'VAL, F
map1 ACCUM, F

map1 OP$, S,50, " addsubtmult div and or not xor"
map1 STR1NG, S,25
map1 REDRAW, F,, 1

map1 PLUS, F,, 1
map1 SUBT, F,, 2
map1 MULT, F,, 3
map1 DIVD, F,, 4
map1 L'AND, F,, 5
map1 L'OR, F,, 6
map1 L'NOT, F,, 7
map1 L'XOR, F,, 8
map1 MEM'ADD, F,, 9
map1 MEM'IN, F,, 10
map1 MEM'OUT, F,, 11
map1 H'LP, F,, 12

map1 OPER, F,, PLUS

map1 NUM, F,, 6
map1 DECIMAL, F,, 1
map1 HEXADEC, F,, 2
map1 OCTAL, F,, 3
map1 R'D50, F,, 4
map1 B1NARY, F,, 5
map1 P'PN, F,, 6
map1 FINI, F,, 7
map1 CLR'MEM, F,, 8
map1 CLR'DSPLAY, F,, 9
map1 XIT, F,, 10
map1 D'SPLAY, F,, 20
map1 ACCUMULATE, F,, 30

set funkey
print tab(-1,0);tab(-1,29);
load.mask "CVT" named "CVT"
put.mask "CVT"

switch OPT

print tab(3,42);OP$[OPER*4-3,OPER*4];

case ACCUMULATE
when OPER = MULT
ACCUM *= FLT
wend
when OPER = SUBT
ACCUM -= FLT
wend
when OPER = DIVD
ACCUM = ACCUM / FLT
wend
when OPER = PLUS
ACCUM += FLT
wend
when OPER = L'AND
ACCUM = ACCUM and FLT
wend
when OPER = L'OR
ACCUM = ACCUM or FLT
wend
when OPER = L'NOT
FLT = not(FLT)
wend
when OPER = L'XOR
ACCUM = ACCUM xor FLT
wend

OPT = D'SPLAY
again
endcase

case DECIMAL
FLT = val(STR1NG)
OPT = ACCUMULATE
again
endcase

case HEXADEC
FLT = cvthex(STR1NG)
OPT = ACCUMULATE
again
endcase

case OCTAL
FLT = cvtoct(STR1NG)
OPT = ACCUMULATE
again
endcase

case R'D50
FLT = 0

for X = 1 to 3

DGT = asc(STR1NG[X,X]) - 64
if DGT = -32 then DGT = 0
if DGT = -28 then DGT = 27
if DGT < 0 then DGT += 46
FLT += (DGT * (1600 * abs(X = 1))) + (DGT * (40 * abs(X = 2))) + (DGT * (abs(X = 3)))

next

if FLT > 65535 then FLT = 65535
OPT = ACCUMULATE
again
endcase

case B1NARY
FLT = cvtbin(STR1NG)
OPT = ACCUMULATE
again
endcase

case P'PN

X = instr(1,STR1NG,",")

when X = 0

print tab(24,1);chr(7);"Format your PPN enty as '[x,x]' please";
FLT = 0

else

if STR1NG[1,1] <> "[" then STR1NG = "[" + STR1NG : X += 1
if STR1NG[len(STR1NG),len(STR1NG)] <> "]" then STR1NG += "]"

FLT = cvtoct(STR1NG[2,X-1]) * 256
FLT += cvtoct( STR1NG[X+1, (len(STR1NG)-1)])

wend

OPT = D'SPLAY
again

endcase

case FINI
FLT = ACCUM
OPT = D'SPLAY
OPER = PLUS
again
endcase

case XIT
print tab(24,1);tab(-1,28);
break
endcase

case D'SPLAY
display.field #DECIMAL of "CVT" from FLT
display.field #HEXADEC of "CVT" from hex$(FLT)
display.field #OCTAL of "CVT" from oct$(FLT)

display.field #(DECIMAL+NUM) of "CVT" from M'VAL
display.field #(HEXADEC+NUM) of "CVT" from hex$(M'VAL)
display.field #(OCTAL+NUM) of "CVT" from oct$(M'VAL)

when FLT < 65536 and FLT >= 0

display.field #R'D50 of "CVT" from rad50$(FLT)
display.field #B1NARY of "CVT" from rjust$(bin$(FLT),16)
display.field #P'PN of "CVT" from "[" + oct$(int(FLT/256)) + "," + oct$(FLT - int(int(FLT/256) * 256)) + "]"

else

display.field #R'D50 of "CVT" from "---"
display.field #B1NARY of "CVT" from ""

wend

when M'VAL < 65536 and M'VAL >= 0

display.field #(R'D50+NUM) of "CVT" from rad50$(M'VAL)
display.field #(B1NARY+NUM) of "CVT" from rjust$(bin$(M'VAL),16)

else

display.field #(R'D50+NUM) of "CVT" from "---"
display.field #(B1NARY+NUM) of "CVT" from ""

wend

OPT = 0
again
endcase

case CLR'DSPLAY
ACCUM = 0
FLT = 0
OPER = PLUS
OPT = D'SPLAY
again
endcase

case CLR'MEM
M'VAL = 0
OPT = D'SPLAY
again
endcase

default case
STR1NG = ""

repeat

print tab(24,60);tab(-1,9);tab(-1,29);
STR1NG = inkey$()
print tab(24,60);tab(-1,9);tab(-1,29);

until valinp(STR1NG)

print tab(24,1);tab(-1,9);
OPT = G1

when OPT < 7

display.field #OPT of "CVT" from ""
accept.field #OPT of "CVT" into STR1NG

else

when ( OPT <> XIT and OPT <> CLR'DSPLAY )

OP'SAV = OPER
OPER = OPT - XIT

when OPER = MEM'ADD
OPER = OP'SAV
M'VAL += FLT
OPT = D'SPLAY
wend

when OPER = MEM'IN
OPER = OP'SAV
M'VAL = FLT
OPT = D'SPLAY
wend

when OPER = MEM'OUT
OPER = OP'SAV
FLT = M'VAL
OPT = ACCUMULATE
wend

when OPER = H'LP
rundos "HELP CVT"
print tab(-1,0);
put.mask "CVT"
OPT = D'SPLAY
OPER = OP'SAV
wend

wend

wend

again
endcase

endswitch

reset funkey

END