! Filename: QCALC.RUN Date: 10/9/91

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