!**************************** 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