!*************************** AMUS Program Label ******************************
! Filename: QCALC.RUN                                       Date: 10/9/91
! Category: UTIL         Hash Code: 124-364-305-624      Version: 1.0(103)       
! Initials: GR/AM        Name: James A. Jarboe IV
! Company: Educational Video Network, Inc.         Telephone #: 4092955767
! Related Files: D/BASIC OR D/RUN
! Min. Op. Sys.: 1.3                           Expertise Level: BEG
! Special: Get STDMAC.MAC, and STDMAC.BSI to compil under d/BASIC
! Description: A quick d/BASIC calculater and/or d/BASIC expression evaluator.
! Can evaluate d/BASIC string and/or math expressions.
! 
!*****************************************************************************
!*! Updated on 08-Oct-91 at 12:06 AM by James A. Jarboe I V; edit time: 3:08:32
!****************************************************************************
!                                                                           *
!  QCALC.BAS  - An interactive d/BASIC calculator and expression handler.   *
!                                                                           *
!****************************************************************************
! 
! This program accepts d/BASIC expressions and/or functions and determines
! the results. 
! - OR -
! This is what happens when a programmer wants a simple way to add 1+2 
! and gets carried away with the idea.
!
! This program was designed,implemented 
!     
!        James A. Jarboe IV                     GR/AM
!        Educational Video Network, Inc
!        1401 19th Street
!        Huntsville, TX 77340
!        1-409-295-5767
!     
! Edit History:
!     
PROGRAM QCALC, 1.0(103)
!
!    [103] 07-Oct-91  Added check for .FNK file.
!    [102] 03-Oct-91  Added F1,F2,F3 help to screen.
!    [101] 02-Oct-91  Added Base display and selection.  
!    [100] 27-Sep-91  Written - James A. Jarboe IV
!
! Additional files:
!        STDMAC.BSI   - Include file with variables that STDMAC.MAC uses.
!        STDMAC.MAC   - Compiled Macro file used with this program.
!        QCALC.HLP    - Online help file for QCALC.RUN
!
! - NOTES -
! Must use with d/RUN version 1.2 or greater.
! 	STDMAC.BSI should be located in BAS:
! 	STDMAC.MSC is the macro source and can be located where you want.
!	QCALC.HLP should be located in HLP:
!     
!
!
++include STDMAC
!
map1 a$,s,100			! EVAL string.
map1 b$,s,100			! SEVAL string.
map1 x$,s,132
map1 fm,s,30			! Form string.
map1 bin'cvt, b, 4		! Binary conversion variable.
map1 bin'byt,@bin'cvt		! Word conversion variable.
	map2 by'byte(4), b, 1
map1 bin'wrd,@bin'cvt		! Byte conversion variable.
	map2 by'word(2), b, 2

! Picklist display options.
!
def max'pick = 5
map1 pick'me(max'pick), s, 30
	pick'me(3)= "Normal Display for Bases"
	pick'me(4)= "Word Display for Bases"
	pick'me(5)= "Byte Display for Bases"
map1 pick'filler, b, 4

map1 pick'1 ,s, 20, "Turn Base Display "
map1 pick'2 ,s, 20, "Set all input for "

map1 pick'adr(max'pick), f
	pick'adr(1) = *reset'base
	pick'adr(2) = *reset'numb
	pick'adr(3) = *reset'norm
	pick'adr(4) = *reset'word
	pick'adr(5) = *reset'byte

map1 pick'select,f		! Pick list value.
map1 displays
	map2 display'base, f, 6, .true
	map2 display'norm, f, 6, .true
	map2 display'word, f, 6, .false
	map2 display'byte, f, 6, .false
	map2 display'numb, f, 6, .true

! Define Window positions.
!
def bx'r = 6
def bx'c = 12
def bx'l = 14
def bx'w = 60

! Define Maximum input retrieval lines.
!
def max's = 10

map1 save'a$(max's), s, 100	! Saved input strings.
map1 save'lvl, f, 6		! Current retrieve level.
float a, e'c 			! Misc floating point variables.
 
! Define Prompt row and column.
!
def pm'r = 8
def pm'c = 14
!
!! Field input Description. 
!
input.field calc
	start at end
	located at pm'r,pm'c
	maximum size 55
	exit using ESCAPE, ^C, ^K, ^J, HELP, F7, TAB, F13, F1, F2, F3
end field
!
on error goto endit

	find.funkey

!! Set up Screen.
!
	x$ = .date using "#ZZZZZ"
	x$ = .day+", "+.month+" "+str(val(x$[3;2]))+", 19"+x$[5;2]
	x$ = .osname+" "+.dosversion+"              "+x$
	init.term "By James A. Jarboe IV",x$,"Current User: "+.username
	call SET'UP'SCREEN
	a$ = ""

!!!!!!!!!!!!!!
!! MAIN LOOP!!
!!!!!!!!!!!!!!
! Accept user input until we are finished.
!
	do accept.field calc into a$, e'c until e'c = 'ESCAPE' or e'c = 3 or e'c = 'F13'
		? tab(-1,29);

		if e'c = 11 call UP'ONE : again
		if e'c = 10 call DN'ONE : again
		if e'c = 'HELP' call HELP : again
		if e'c = 'TAB' call HELP : again
		if e'c = 'F7' call PICK'OPTION : again

		when e'c = 'F1'  or e'c = 'F2' or e'c = 'F3'
			switch on e'c
				case 'F1' : call reset'norm : endcase
				case 'F2' : call reset'word : endcase
			  	case 'F3' : call reset'byte : endcase		
			endswitch
			call DISPLAY'OPTIONS
			call show'base
			again
		wend

! If no input get some.
!
		if a$ = "" again
		a = 0
		call show'equate

! If command is preceeded by a "$" then use SEVAL otherwise use EVAL.
!
		when display'numb = .false
			if a$[1,1] <> "$" then a$="$"+a$
		wend
		
		when a$[1,1] = "$"
			b$=seval(a$[2,-1])
		else
			a=eval(a$)
		wend
	
		when err(4)
			a=0 : b$ = ""
			call show'result
			call show'error
		else
			call show'result
		wend

		x = max's+1

! Bump saved input list and drop oldest one.
!
		do x-=1 until x = 1
			save'a$(x) = save'a$(x-1)
		enddo

! Save current input line.
!
		save'a$(1) = a$
		a$ = "" : b$ = ""
		x = 0   : save'lvl = 0
		call show'input
	enddo

! Must be finished. Clear box and end.
! 
	init.term
	? tab(-1,28);
	end

!!!!!!!!!!!!!!!
!!SUBROUTINES!!
!!!!!!!!!!!!!!!
!
!
!! Set up Quick Calculator Screen
!
SET'UP'SCREEN:
	call REDISPLAY'SCREEN
	return

!
!! Redisplay the input screen.
!
REDISPLAY'SCREEN:
	? tab(-1,29);
	drawbox  bx'r, bx'c, bx'l, bx'w
	x$ = "_ d/BASIC Quick Calculator _"
	? tab(bx'r, (80/2)+(len(x$)/2)+2);tab(-1,33);
	dual.print tab(bx'r, (80/2)-(len(x$)/2)+3 );tab(-1,32);x$;tab(-1,33);
	fm="p"+str(bx'r+3)+","+str(bx'c)+"<-"+str(bx'w-2)+">"
	draw.form fm
	fm="p"+str(bx'r+5)+","+str(bx'c)+"<-"+str(bx'w-2)+">"
	draw.form fm
	fm="p"+str(bx'r+11)+","+str(bx'c)+"<-"+str(bx'w-2)+">"
	draw.form fm
	x = int((bx'w/2)+bx'c-2)
	fm="p"+str(bx'r+11)+","+str(x)+"d^|v"
	draw.form fm
	? tab(-1,28);	
	dual.print tab(pm'r+2,bx'c+1);tab(-1,29);"Evaluate: _";
	dual.print tab(pm'r+4,bx'c+1);tab(-1,29);"  Result: _";
	x$ ="Press _F7_ for OPTIONS, Press _TAB_ or _HELP_ for HELP"
	dual.print tab(bx'r+bx'l+1, 1);center(x$,80+6);
	x$ = "Base Display  _F1_:Normal   _F2_:Words   _F3_:Bytes"
	dual.print tab(bx'r+bx'l+2, 1);center(x$,80+6);
	call DISPLAY'OPTIONS
	dual.print tab(pm'r,bx'c+1);"_>"
	return

!
!! Display user input. 
!
show'input:
	display.field calc from a$
	? tab(-1,29);
	return

!
!! Display any eval or sval errors.
!
show'error:
	display.error "_Error CODE _"+str(err(4)) +"_ - _"+errmsg(err(4))
	return

!
!! Display the input expression.
!
show'equate:
	dual.print tab(pm'r+2,bx'c+11);tab(-1,29);ljust("_"+a$+"_",39);
	return

!
!! Display the evaluation of the expression.
!
show'result:
	? tab(pm'r+4,bx'c+11);
	when a$[1,1] = "$"
		dual.print ljust(chr(34)+"_"+b$+"_"+chr(34),39);
	else
		dual.print ljust("_"+str(a)+"_",50);
	wend
	call show'base
	return

!
!! Display different base
!
show'base:
	if a = 0 then a = val(b$)
	if display'base = .false : return

	bin'cvt = a
	
	when display'norm = .true
	dual.print tab(pm'r+6,bx'c+2);"  Octal: _";ljust(oct$(a), 38);
	dual.print tab(pm'r+7,bx'c+2);"    Hex: _";ljust(hex$(a), 38);
	dual.print tab(pm'r+8,bx'c+2);" Binary: _";ljust(bin$(a), 38);
	wend

	when display'word = .true
	dual.print tab(pm'r+5,bx'c+2);"Decimal: _";rjust(by'word(2),18);"  ";rjust(by'word(1),18);
	dual.print tab(pm'r+6,bx'c+2);"  Octal: _";rjust(oct$(by'word(2)),18);"  ";rjust(oct$(by'word(1)), 18);
	dual.print tab(pm'r+7,bx'c+2);"    Hex: _";rjust(hex$(by'word(2)),18);"  ";rjust(hex$(by'word(1)), 18);
	dual.print tab(pm'r+8,bx'c+2);" Binary: _";rjust(bin$(by'word(2)),18);"  ";rjust(bin$(by'word(1)),18);
	wend

	when display'byte = .true
	dual.print tab(pm'r+5,bx'c+2);"Decimal: _";rjust(by'byte(4),8);"  ";rjust(by'byte(3),8);
	dual.print "  _";rjust(by'byte(2),8);"  ";rjust(by'byte(1),8);

	dual.print tab(pm'r+6,bx'c+2);"  Octal: _";rjust(oct$(by'byte(4)),8);"  ";rjust(oct$(by'byte(3)),8);
	dual.print "  _";rjust(oct$(by'byte(2)),8);"  ";rjust(oct$(by'byte(1)), 8);

	dual.print tab(pm'r+7,bx'c+2);"    Hex: _";rjust(hex$(by'byte(4)),8);"  ";rjust(hex$(by'byte(3)),8);
	dual.print "  _";rjust(hex$(by'byte(2)),8);"  ";rjust(hex$(by'byte(1)), 8);

	dual.print tab(pm'r+8,bx'c+2);" Binary: _";rjust(bin$(by'byte(4)),8);"  ";rjust(bin$(by'byte(3)),8);
	dual.print "  _";rjust(bin$(by'byte(2)),8);"  ";rjust(bin$(by'byte(1)),8);
	wend
	return

!
!! Clear Screen of Base Prompts.
!
clear'base:
	for x = 5 to 8
	? tab(pm'r+x,bx'c+2);space$(50);
	next x
	return

! On up arrow bring back previous input line.
!
UP'ONE:
	x = save'lvl
	x+=1
	if x > max's then  x = max's : call BELL
	if save'a$(x) = "" x-=1 : call BELL
	if x<1 x = 1 
	a$ = save'a$(x)
	save'lvl = x
	call show'input
	return

! On down arrow bring back last input line.
!
DN'ONE:
	x = save'lvl
	x-=1
	if x < 1 x = 1 : call BELL
	a$ = save'a$(x)
	save'lvl = x
	call show'input
	return

! 
!! Ring the bell
!
BELL:
	? chr$(7);
	return

!
!! Get some help
!
HELP:
	? tab(-1,0);
	rundos "HELP QCALC"
	? TAB(-1,0);
	call SET'UP'SCREEN
	call show'result
	return

!
!! Display the Option window.
!
DISPLAY'OPTIONS:
	dual.print tab(bx'r+bx'l-2,bx'c+2);
	when display'base = .true
		dual.print "Display Base as _";
		if display'norm = .true then dual.print "_Normal " 
		if display'word = .true then dual.print "_Words  "
		if display'byte = .true then dual.print "_Bytes  "
	else
		dual.print "_No_ Base Display        "
		call clear'base
	wend
	x = int((bx'w/2)+bx'c+3)
	dual.print tab(bx'r+bx'l-2,x);"Input Mode: _";
	when display'numb = .true	
		dual.print "_NUMERIC_  ";
	else	
		dual.print "_STRING_  ";
	wend
	return

!
!! Pick an option from the list.
!
PICK'OPTION:
	wipebox bx'r+1, bx'c+9, 10, 40
	pick'me(1) = pick'1
	pick'me(2) = pick'2
	when display'base = .true
		pick'me(1)= pick'me(1)+"OFF"
	else
		pick'me(1)= pick'me(1)+"ON"
	wend	
	when display'numb = .true
		pick'me(2) = pick'me(2)+"STRINGS "
	else
		pick'me(2) = pick'me(2)+"NUMERICS"
	wend

	reset uplowcase
	pick.list into pick'select
		text array pick'me(1)
		located at bx'r+2, bx'c+10
		depth 5
		title "Select Option or ESCAPE to EXIT"
	end picklist
	set uplowcase

	wipebox bx'r+1, bx'c+9, 10, 40
	when pick'select > 0 and pick'select <= max'pick
		call @pick'adr(pick'select)
	wend
	call REDISPLAY'SCREEN	
	call show'result
	return

!
reset'base:
	display'base = NOT display'base
	return

!
reset'norm:
	dual.print tab(pm'r+5,bx'c+2);space$(50);
	display'base = .true
	display'norm = .true
	display'word = .false
	display'byte = .false
	return

!
reset'word:
	display'base = .true
	display'word = .true
	display'norm = .false
	display'byte = .false
	return

!
reset'byte:
	display'base = .true
	display'word = .false
	display'norm = .false
	display'byte = .true
	return

!
reset'numb:
	display'numb = NOT display'numb
	return
!
!! Resume on error condition.
!
endit:
	resume