home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
GAGEBLOX.ZIP
/
GAGEBLOX.ASI
next >
Wrap
Text File
|
1993-02-28
|
13KB
|
575 lines
dim gag&(81)
dim row(81)
dim col(81)
dim trh(81)
data 1001&,1002&,1003&,1004&,1005&,1006&,1007&,1008&,1009&
data 1010&,1020&,1030&,1040&,1050&,1060&,1070&,1080&,1090&,1100&
data 1110&,1120&,1130&,1140&,1150&,1160&,1170&,1180&,1190&,1200&
data 1210&,1220&,1230&,1240&,1250&,1260&,1270&,1280&,1290&,1300&
data 1310&,1320&,1330&,1340&,1350&,1360&,1370&,1380&,1390&,1400&
data 1410&,1420&,1430&,1440&,1450&,1460&,1470&,1480&,1490&
data 500&,1000&,1500&,2000&,2500&,3000&,3500&,4000&,4500&,5000&
data 5500&,6000&,6500&,7000&,7500&,8000&,8500&,9000&,9500&
data 10000&,20000&,30000&,40000&
data 3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,6
data 6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8
data 9,9,9,9,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11,11,11
data 10,18,26,34,42,50,58,66,74,10,18,26,34,42,50,58,66,74
data 2,10,18,26,34,42,50,58,66,74,2,10,18,26,34,42,50,58,66,74
data 2,10,18,26,34,42,50,58,66,74,2,10,18,26,34,42,50,58,66,74
data 10,18,26,34,42,50,58,66,74,2,10,18,26,34,42,50,58,66,74,26,34,42,50
2zero$=".00"
decpt$="."
spac$=" "
zero$=chr$(0)
fifnin$=chr$(59)
sevone$=chr$(71)
sevtwo$=chr$(72)
sevfiv$=chr$(75)
sevsev$=chr$(77)
eighty$=chr$(80)
eigtwo$=chr$(82)
eigthr$=chr$(83)
fone$=zero$+fifnin$
esc$=chr$(27)
uparr$=zero$+sevtwo$
dnarr$=zero$+eighty$
rtarr$=zero$+sevsev$
lfarr$=zero$+sevfiv$
home$=zero$+sevone$
ins$=zero$+eigtwo$
del$=zero$+eigthr$
for x=1 to 81
read gag&(x)
next x
for x=1 to 81
read row(x)
next x
for x=1 to 81
read col(x)
next x
begin: cls
color 7,4
gosub newtab:
color 4,7
locate 1,35
print " GAGE-BLOX "
locate 22,25
print " F1 "
locate 22,44
print " ESC "
color 7,1
locate 14,14
print " GAGE-BLOX -- The values in the above table represent "
locate 15,14
print " decimal inch thicknesses of each block in a standard "
locate 16,14
print " 82-block English-system gage block set. F1 to enter "
locate 17,14
print " the calculator. Read the instructions on that screen "
locate 18,14
print " for operation. Checked but accuracy at risk of user. "
color 7,4
locate 22,29
print " CALCULATE "
locate 22,49
print " EXITS "
effloop:
a$=inkey$
if a$=fone$ then manual:
if a$=esc$ then leave:
goto effloop:
manual: cls
mode$="manual"
color 4,7
locate 1,35
print " GAGE-BLOX "
locate 13,23
print " MANUAL MODE "
locate 21,20
print " INS "
locate 21,42
print " DEL "
locate 23,20
print " HOME "
locate 23,42
print " ESC "
color 7,1
locate 13,36
print " F1 to enter AUTO MODE "
color 7,4
gosub newtab:
locate 15,23
print " Use arrow keys to position cursor. "
locate 17,25
print " Current Stack Height = "
locate 18,25
print " Program resets any over 9.9999 "
locate 21,26
print " Adds Block "
locate 21,47
print " Removes Block "
locate 23,26
print " Clear/Reset "
locate 23,47
print " EXITS Program "
reset1:
color 7,4
gosub newtab:
stack&=0
stack$=" 0.0000 "
gage=1
color 4,7
goto prt:
in1:
if trh(gage)=0 then
color 7,12
endif
if trh(gage)=1 then
color 15,12
endif
gosub prtgag:
in1loop:
a$=inkey$
if a$=fone$ then auto:
if a$=uparr$ then upcur:
if a$=dnarr$ then dwncur:
if a$=rtarr$ then ritcur:
if a$=lfarr$ then lefcur:
if a$=ins$ then addblk:
if a$=del$ then remblk:
if a$=home$ then reset1:
if a$=esc$ then leave:
goto in1loop:
replc:
if trh(gage)=0 then unselect:
reselect:
color 15,4
gosub prtgag:
return
unselect:
color 7,4
gosub prtgag:
return
upcur:
gosub replc:
if gage>77 then
gage=gage-7
goto in1:
endif
if gage>68 then
gage=gage-10
goto in1:
endif
if gage=68 then
gage=49
goto in1:
endif
if gage>58 then
gage=gage-9
goto in1:
endif
if gage>19 then
gage=gage-10
goto in1:
endif
if gage=19 then in1:
if gage<10 then in1:
gage=gage-9
goto in1:
dwncur:
gosub replc:
if gage>74 then in1:
if gage>70 then
gage=gage+7
goto in1:
endif
if gage>67 then in1:
if gage>58 then
gage=gage+10
goto in1:
endif
if gage>49 then
gage=gage+9
goto in1:
endif
if gage=49 then
gage=68
goto in1:
endif
if gage>9 then
gage=gage+10
goto in1:
endif
gage=gage+9
goto in1:
ritcur:
gosub replc:
if gage=9 then in1:
if gage=18 then in1:
if gage=28 then in1:
if gage=38 then in1:
if gage=48 then in1:
if gage=58 then in1:
if gage=67 then in1:
if gage=77 then in1:
if gage=81 then in1:
gage=gage+1
goto in1:
lefcur:gosub replc:
if gage=1 then in1:
if gage=10 then in1:
if gage=19 then in1:
if gage=29 then in1:
if gage=39 then in1:
if gage=49 then in1:
if gage=59 then in1:
if gage=68 then in1:
if gage=78 then in1:
gage=gage-1
goto in1:
addblk:
if trh(gage)=1 then in1:
stack&=stack&+gag&(gage)
check$=str$(stack&)
check$=ltrim$(check$)
check=len(check$)
if check>5 then reset1:
trh(gage)=1
color 4,7
goto prtstk:
remblk:
if trh(gage)=0 then in1:
trh(gage)=0
stack&=stack&-gag&(gage)
color 4,7
prtstk:
stk$=str$(stack&)
stk$=ltrim$(stk$)
check=len(stk$)
if stack&=0 then
stack$=" 0.0000 "
goto prt:
endif
if stack&=500& then
stack$=" 0.0500 "
goto prt:
endif
if stack&<10000& then
if check=5 then glitch:
stack$=" 0."
stack$=stack$+stk$
stack$=stack$+spac$
goto prt:
endif
if stack&>9999& then
glitch: stack$=left$(stk$,1)
stk$=right$(stk$,4)
stack$=spac$+stack$
stack$=stack$+decpt$
stack$=stack$+stk$
stack$=stack$+spac$
endif
prt: locate 17,49
print stack$
if mode$="manual" then in1:
if mode$="auto" then in2:
newtab: for x=1 to 81
trh(x)=0
gage=x
gosub prtgag:
next x
return
prtgag: gage$=str$(gag&(gage))
gage$=ltrim$(gage$)
if gage<78 then
gage$=decpt$+gage$
endif
if gage>77 then
gage$=left$(gage$,1)
gage$=gage$+2zero$
gage$=spac$+gage$
endif
gage$=gage$+spac$
if gage=59 then
gage$=".0500 "
endif
locate row(gage),col(gage)
print gage$
return
leave: color 7,0
cls
end
auto: cls
mode$="auto"
stack$=" 0.0000 "
color 7,1
gosub newtab:
locate 17,25
print " Display Stack Height = "
locate 18,25
print " Program limit is set at 9.9999 "
locate 23,26
print " Start/Reset "
locate 23,47
print " EXITS Program "
color 7,4
locate 13,34
print " F1 to enter MANUAL MODE "
color 1,7
locate 1,35
print " GAGE-BLOX "
locate 13,23
print " AUTO MODE "
locate 23,20
print " HOME "
locate 23,42
print " ESC "
goto prt:
in2: a$=inkey$
if a$=fone$ then manual:
if a$=home$ then reset2:
if a$=esc$ then leave:
goto in2:
reset2:
stack$=" 0.0000 "
color 7,1
gosub newtab:
locate 15,23
print " Enter 5-digit target stack height. "
locate 17,25
print " Target Stack Height = "
locate 18,25
color 1,7
locate 17,49
print stack$
lp1: color 1,7
locate 17,50
a$=inkey$
if a$="0" then
print "0.";
stack$="0."
goto lp2:
endif
if a$="1" then
print "1.";
stack$="1."
goto lp2:
endif
if a$="2" then
print "2.";
stack$="2."
goto lp2:
endif
if a$="3" then
print "3.";
stack$="3."
goto lp2:
endif
if a$="4" then
print "4.";
stack$="4."
goto lp2:
endif
if a$="5" then
print "5.";
stack$="5."
goto lp2:
endif
if a$="6" then
print "6.";
stack$="6."
goto lp2:
endif
if a$="7" then
print "7.";
stack$="7."
goto lp2:
endif
if a$="8" then
print "8.";
stack$="8."
goto lp2:
endif
if a$="9" then
print "9.";
stack$="9."
goto lp2:
endif
if a$=fone$ then manual:
if a$=home$ then reset2:
if a$=esc$ then leave:
goto lp1:
lp2: for x=1 to 4
lp3: a$=inkey$
if a$="0" then
print "0";
stack$=stack$+"0"
goto nxt:
endif
if a$="1" then
print "1";
stack$=stack$+"1"
goto nxt:
endif
if a$="2" then
print "2";
stack$=stack$+"2"
goto nxt:
endif
if a$="3" then
print "3";
stack$=stack$+"3"
goto nxt:
endif
if a$="4" then
print "4";
stack$=stack$+"4"
goto nxt:
endif
if a$="5" then
print "5";
stack$=stack$+"5"
goto nxt:
endif
if a$="6" then
print "6";
stack$=stack$+"6"
goto nxt:
endif
if a$="7" then
print "7";
stack$=stack$+"7"
goto nxt:
endif
if a$="8" then
print "8";
stack$=stack$+"8"
goto nxt:
endif
if a$="9" then
print "9";
stack$=stack$+"9"
goto nxt:
endif
if a$=fone$ then manual:
if a$=home$ then reset2:
if a$=esc$ then leave:
goto lp3:
nxt: next x
print " "
calstk: carry=0
a$=mid$(stack$,6,1)
a=val(a$)
if a=0 then hund:
trh(a)=1
gosub tendock:
hund: a$=mid$(stack$,4,2)
a=val(a$)
if a=0 then tenths:
if a=50 then
carry=1
goto tenths:
endif
if a>50 then
a=a-50
carry=1
endif
b=a+9
trh(b)=1
gosub tendock:
tenths:
a$=mid$(stack$,3,1)
a=val(a$)
a=10*a
if carry=1 then
a=a+5
endif
if a=5 then
trh(59)=1
goto units:
endif
for x=60 to 77
a$=str$(gag&(x))
a$=ltrim$(a$)
a$=left$(a$,2)
b=val(a$)
if a=b then
trh(x)=1
endif
next x
units: a$=left$(stack$,1)
a=val(a$)
if a=9 then
trh(79)=1
trh(80)=1
trh(81)=1
endif
if a=8 then
trh(78)=1
trh(80)=1
trh(81)=1
endif
if a=7 then
trh(80)=1
trh(81)=1
endif
if a=6 then
trh(79)=1
trh(81)=1
endif
if a=5 then
trh(79)=1
trh(80)=1
endif
if a=4 then
trh(81)=1
endif
if a=3 then
trh(80)=1
endif
if a=2 then
trh(79)=1
endif
if a=1 then
trh(78)=1
endif
color 15,1
for x=1 to 81
if trh(x)=1 then
gage=x
gosub prtgag:
endif
next x
color 7,1
locate 15,23
print " MANUAL MODE can be used to verify. "
locate 17,25
print " Display Stack Height = "
goto in2:
tendock:
a$=mid$(stack$,3,1)
a=val(a$)
b$=left$(stack$,1)
b=val(b$)
c=a+b
if c=0 then reset2:
if a=0 then
b=asc(b$)
b=b-1
stk$=chr$(b)
stk$=stk$+"."
stk$=stk$+"9"
a$=mid$(stack$,4,3)
stack$=stk$+a$
return
endif
b=asc(a$)
b=b-1
b$=chr$(b)
stk$=left$(stack$,2)
stk$=stk$+b$
a$=mid$(stack$,4,3)
stack$=stk$+a$
return