WikiAdmin: 1 revision imported

2023-07-14T12:58:48Z

1 revision imported

← Older revision

Revision as of 12:58, 14 July 2023

Intra>User: 1 revision imported

2017-01-10T00:01:26Z

1 revision imported

New page

Jim B. Metric Function

<PRE>
64000 REM metric/standard conversion - FNMETCONV ! 07/12/95 \/
64005 REM returns loc in vector if a conversion is performed: 0 if not
64010 REM :METRICSW - is the switch for conversion style
64015 REM :INUM$ - the incoming um to test for conversion
64020 REM :&DETCF - the returned detail conversion factor
64025 REM :&dnum$ - the returned um for detail - c 3
64030 REM :&tnum$ - the returned um for totals - c 3
64035 REM ******** notes on FNMETCONV usage *********
64040 REM may need imast to get UM$ @ pos 21,c 2
64045 REM may need HUM$=UM$ after totals cleanup to print prev UM$
64050 REM move to after bisys read ! LET METRICSW:=POS("1234",QB$(4)(29:29)) ! 07/12/95
64055 REM move to after totals processing - before printing new detail - NOTE: NOT AN IF ! LET FNMETCONV(METRICSW,um$,detcf,totcf,dnum$,tnum$,acsw) ! 07/12/95
64060 REM in program call, METRICSW is only forced var name(is=qb$(4)(29:29))
64065 REM example - after function call - after qty (re)read - before detail printing ! LET QTY=ROUND(QTY*detcf,2) ! 07/12/95
64070 REM example - in accumulating section - after detail print - NOTE: ONLY ON K=1 ! TQTY(1)=TQTY(1)+ROUND(QTY*totcf,2) ! 07/12/95
64100 DEF FNMETCONV(METRICSW,INUM$,&DETCF,&TOTCF,&DNUM$,&TNUM$,&ACSW) ! 07/12/95 \/
64110 DIM MUM$(1)*4,MCF(1)
64120 LET DETCF:=TOTCF:=1
64130 LET DNUM$=TNUM$=INUM$
64140 IF NOT METRICSW THEN GOTO 64360 ! ? conversion
64150 IF UDIM(MUM$)<2 THEN GOSUB METSET ! initialize
64160 IF (SIRCH:=SRCH(MUM$,INUM$))>-1 AND (CMO:=FNCMOD(SIRCH,MUMCOL))<3 THEN
64170 LET FNMETCONV=SIRCH
64180 LET ACSW=VAL(MUM$(FNLINR(FNRMOD(SIRCH,MUMCOL),4,MUMCOL))) ! accume ?
64190 IF FNCMOD(METRICSW,2)<>CMO THEN
64200 LET TNUM$=(MUM$(SIRCH+3-2*CMO)) ! the other um of the pair
64210 LET DETCF=MCF(VAL(MUM$(FNLINR(FNRMOD(SIRCH,MUMCOL),3,MUMCOL))))**(-1**(MOD(METRICSW,2))) ! look below for explanation
64220 IF METRICSW>2 THEN ! totals only
64230 LET TOTCF=DETCF
64240 LET DETCF=1
64250 ELSE LET DNUM$=TNUM$&"*"
64260 END IF
64270 GOTO 64380
64300 REM ******** explanation of equation *********
64305 REM MCF(VAL(MUM$(FNRMOD(SIRCH,3)*3))) is the conversion multiplier pointed to in MCF from the 3rd element in the row that INUM$ was found in MUM$
64310 REM mod(metricsw,2) yields 0 if to metric, 1 if to std ...
64315 REM -1**mod(metricsw,2) yields 1 if std to met, -1 if met to std to invert the conversion factor to met to std
64320 REM fncmod(sirch,3) yields 1 if is std um, 2 if is metric um, 3 if found the mcf ref thus invalid
64325 REM fncmod(metricsw,2)<>fncmod(sirch,3) yields 1 if std and convert to met or if met and convert to std i.e. if a conversion is required, 0 if not
64330 REM conversion factor exponent is n**(1 or -1 to invert), get it?
64350 END IF
64360 REM no conversion
64370 LET FNMETCONV=ACSW=0
64380 FNEND ! FNMETCONV() ! 07/12/95 /\
64400 METSET: ! 07/12/95 \/ setup for FNMETCONV
64410 DIM MUMSRC$*128
64420 LET MUMSRC$="CY,CM,1,2,YD,MR,1,1,TN,MT,2,1,Y,M,1,0,T,TM,2,0" ! english then metric in then mcf reference - is really a ZxMUMCOL matrix
64430 LET FNMKARAY(MAT MUM$,MUMSRC$,",")
64440 LET MUMCOL=4
64450 MAT MCF(9)=(0) ! conversion factors in metric per english units
64460 LET MCF(1)=(2.54*9/25)**3 ! cubic meters per cubic yard
64470 LET MCF(2)=.453592*2 ! metric tons(1kKg) per english tons(2kLb)
64480 LET MCF(3)=2.54*9/25 ! linear meter per linear yard
64490 LET MCF(4)=1 !
64500 LET MCF(5)=1 !
64510 LET MCF(6)=1 !
64520 LET MCF(7)=1 !
64530 LET MCF(8)=1 !
64540 LET MCF(9)=1 !
64550 RETURN ! METSET ! 07/12/95 /\
64560 REM ******* notes for METSET ********
64565 REM matrix elements: x,1-standard um : x,2-metric um : x,3-mcf reference for conversion factor s.t. (x,1)*(x,3)=qty in (x,2) units : x,4-priority for accumulation of um i.e. to accum CY and TN use (x,4)<>0
64600 DEF FNMETUM$(CRUM$,&CF,&ACSW) ! 07/12/95 \/
64610 IF UDIM(MUM$)<2 THEN GOSUB METSET
64620 LET ROCOL=(ROCOL:=0 OR VAL(CRUM$)) CONV 64650 ! is crum$ a um or coords(rr.cc) ?
64630 LET FNMETUM$=MUM$(FNLINR(INT(ABS(ROCOL)),MOD(3+SGN(ROCOL)*INT(MOD(ABS(ROCOL),1)*100),3),MUMCOL)) ERROR 64690 ! invalid sub
64640 GOTO 64660
64650 IF (SIRCH:=SRCH(MUM$,CRUM$))>-1 AND FNCMOD(SIRCH,MUMCOL)<3 THEN LET FNMETUM$=STR$(FNRMOD(SIRCH,MUMCOL)+.01*FNCMOD(SIRCH,MUMCOL)) ELSE GOTO 64690
64660 LET CF=MCF(VAL(MUM$(FNLINR(FNRMOD(SIRCH,MUMCOL),3,MUMCOL))))
64670 LET ACSW=VAL(MUM$(FNLINR(FNRMOD(SIRCH,MUMCOL),4,MUMCOL)))
64680 GOTO 64700
64690 LET FNMETUM$="": LET CF=ACSW=0
64700 FNEND ! FNMETUM ! 07/12/95 /\
64710 REM ******** notes for FNMETUM$ *********
64720 REM CRUM$ : row and column string as "+rr.cc" or um
64725 REM &CF : becomes conversion factor
64730 REM &ACSW : becomes switch setting for if that um's totals are accummed
64735 REM returns: if crum is a um then returns the "rr.cc" in mum that um was found
64740 REM : if "rr.cc" then returns the um in that spot
64745 REM : if "-rr.cc" then returns the other um of the pair
64750 REM i.e fnmetum$("-"&fnmetum$("CY",x,y),x,y) returns "CM",x=.76,y=1
64755 REM FNMETUM$ is NOT DEPENDANT ON METRICSW
64800 DEF FNMKARAY(MAT TARG$,&SRC$,DL$*1) ! 07/12/95 \/
64810 REM ******** FNMKARAY usage notes *********
64820 REM send it an empty array (targ$), a delimited string (src$),
64830 REM and the deliminter used (dl$). src$ is cleaned up so that
64840 REM empty elements need to be repped as a space(or else disable
64850 REM the srep calls. FNMKARAY returns the number of elements.
64860 MAT TARG$(MKR:=MKL:=0)
64870 LET SRC$:=DL$&SRC$&DL$
64880 IF POS(SRC$:=SREP$(SRC$,DL$&DL$,DL$),DL$&DL$) THEN GOTO 64880
64890 LET MKL=MKR+1
64900 IF (MKR:=(POS(SRC$,DL$,MKL+1)-1))<0 THEN GOTO 64940
64910 MAT TARG$(UDIM(TARG$)+1)
64920 LET TARG$(UDIM(TARG$))=SRC$(MKL+1:MKR)
64930 GOTO 64890
64940 LET FNMKARAY=UDIM(TARG$)
64950 FNEND ! FNMKARAY ! 07/12/95 /\
64970 DEF FNLINR(R,C,E)=E*(R-1)+C ! 07/12/95 lin ref - cth el in rth row e cols
64980 DEF FNCMOD(X,Y)=(MOD(X-1,Y)+1)*(X>0) ! 07/12/95 in which of y column is x
64990 DEF FNRMOD(X,Y)=INT((X-1)/Y)+1 ! 07/12/95 which row of y columns is x in
</PRE>

New Function to replace:
<PRE>
89110 DIM INUNIT$(1)*2,OUTUNIT$(1)*2,CONVFACT(1)
89120 DEF FNMETRIC(INUM$,OUTUM$,VALUE) ! 05/14/98 - Metric Conversion Function
89125 IF UPRC$(INUM$)=UPRC$(OUTUM$) THEN LET FNMETRIC=VALUE: GOTO 89230
89130 IF UDIM(INUNIT$)>1 THEN GOTO 89180
89140 OPEN #10: "NAME=METRIC.CFG,SHR",DISPLAY,INPUT
89150 INPUT #10: I$,O$,F EOF 89170
89160 LET X=UDIM(INUNIT$)+1: MAT INUNIT$(X): MAT OUTUNIT$(X): MAT CONVFACT(X): LET INUNIT$(X)=I$: LET OUTUNIT$(X)=O$: LET CONVFACT(X)=F: GOTO 89150
89170 CLOSE #10:
89180 LET FOUND=I=FNMETRIC=0
89190 LET I=I+1
89200 IF UPRC$(INUM$)=INUNIT$(I) AND UPRC$(OUTUM$)=OUTUNIT$(I) THEN LET FNMETRIC=VALUE*CONVFACT(I): LET FOUND=1
89210 IF UPRC$(OUTUM$)=INUNIT$(I) AND UPRC$(INUM$)=OUTUNIT$(I) THEN LET FNMETRIC=VALUE/CONVFACT(I): LET FOUND=1
89220 IF FOUND=0 AND I<UDIM(INUNIT$) THEN GOTO 89190
89230 FNEND
</PRE>

METRIC.CFG
<PRE>
"KG","LB",2.204622
"MT","LB",2204.6215
"MT","TN",1.102311
"CM","CY",1.307873
"CY","CF",27
"CM","CF",35.312571
"M","YD",1.093613
"MT","KG",1000
"M","IN",39.30
"TN","KG",907.184996
"TN","LB",2000
"M","FT",3.28084
"OZ","ML",29.573529
"GL","L",3.785412
"GL","OZ",128
"L","OZ",33.814021
</PRE>

Bad Code - Revision history

WikiAdmin: 1 revision imported

Intra>User: 1 revision imported