DataMuseum.dk

top - download

    Length: 4096 (0x1000)
    Types: TextFile
    Names: »MAKER.PRG«

└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
    └─ ⟦this⟧ »MAKER.PRG« 

TextFile

*******************************************************************************
* DESIGN NIF/ASD/SEPTEMBER 1985
*
*PROCEDURE: MAKER
*PARAM: DBASE IN USE
*CONVERTS NVALUE TO CVALUE AND SPECVALUE FOR RESISTORS
*
*******************************************************************************

LOCATE FOR $(REF:CODE,1,1)='4'
DO WHILE $(REF:CODE,1,1)='4'.AND..NOT.EOF

*CONVERT NVALUE
STORE STR(NVALUE,13,4) TO MOPER
STORE 13 TO MLENO

* 'REMOVE LEADING BLANKS AND ZEROES'
DO WHILE RANK(MOPER)=32.OR.RANK(MOPER)=48
   STORE MLENO-1 TO MLENO
   STORE $(MOPER,2,MLENO) TO MOPER
ENDDO

* 'GENERATE ENGENEERING NOTATION'
STORE @('.',MOPER) TO MPOINT
DO CASE
   CASE MPOINT>=8
        STORE 'M' TO MSEP
        STORE MPOINT -7 TO MBEF
   CASE MPOINT>=5
        STORE 'K' TO MSEP
        STORE MPOINT-4 TO MBEF
   OTHERWISE
        STORE 'R' TO MSEP
        STORE MPOINT-1 TO MBEF
ENDCASE
* 'CHECKPOINT: STRING OPERATIONS'
DO CASE
   CASE MPOINT>2
        STORE $(MOPER,1,MPOINT-1) TO MINT
        STORE $(MOPER,MPOINT+1,4) TO MENG2
        STORE $(MINT,1,MBEF) TO MENG1
        IF MBEF<LEN(MINT)
           STORE $(MINT,MBEF+1,MPOINT-MBEF-1)-MENG2 TO MENG2
        ENDIF
        STORE MENG1-MSEP-MENG2 TO MCVAL
   CASE MPOINT=2
        STORE $(MOPER,1,1)-MSEP-$(MOPER,3,4) TO MCVAL
   OTHERWISE
        STORE 'R'-$(MOPER,MPOINT+1,4) TO MCVAL
ENDCASE
ENDIF
IF LEN(MCVAL)<3
   STORE MCVAL-'0' TO MCVAL
ENDIF
STORE LEN(MCVAL) TO MLENC
DO WHILE (MLENC>3.AND.$(MCVAL,MLENC,1)='0').OR.MLENC>8
   STORE MLENC-1 TO MLENC
   STORE $(MCVAL,1,MLENC) TO MCVAL
ENDDO
IF LEN(MCVAL)<4.AND.VAL(TOLERANCE)<2.AND.'%'$TOLERANCE
   REPLACE CVALUE WITH MCVAL-'0'
ELSE
   REPLACE CVALUE WITH MCVAL
ENDIF

*GENRATION OF VALUE FOR THE SPEC:CODE

*INITIALIZE VAR
STORE SPEC:CODE TO MSPEC
STORE @('<V',MSPEC) TO MSTART
STORE @('V>',MSPEC) TO MSTOP

*FIND LENGTH OF ACTUAL FORMAT FOR SPEC:VALUE
STORE VAL($(MSPEC,MSTART+2,1)) TO MFLOAT
STORE MSTOP-MSTART TO MLENS
STORE $(TOLERANCE,1,3) TO MTOL
IF &MTOL>1.AND.'%'$TOLERANCE
   DO WHILE MFLOAT>0
      STORE MLENS-1 TO MLENS
      STORE MFLOAT-1 TO MFLOAT
   ENDDO
ENDIF

IF MLENS>0
DO CASE
    CASE '@E@'$MSPEC
         *GENERATE VALUE IN ENG. NOTATION
         STORE MCVAL TO MSVAL
         DO WHILE LEN(MSVAL)<MLENS
            STORE MSVAL-'0' TO MSVAL
         ENDDO

   OTHERWISE
        *GENERATE VALUE IN SCC-SPEC. NOTATION
         STORE $(MOPER,1,MLENS) TO MSVAL
         IF MPOINT<MLENS
            IF MPOINT=1
               STORE 'R'-$(MSVAL,2,MLENS-1) TO MSVAL
            ELSE
               STORE $(MSVAL,1,MPOINT-1)-'R'-$(MSVAL,MPOINT+1,MLENS) TO MSVAL
            ENDIF
         ELSE
            STORE $(MSVAL,1,MLENS-1)-STR(MPOINT-MLENS,1) TO MSVAL
         ENDIF
ENDCASE

*INSERT IN SPEC:CODE
STORE $(MSPEC,1,MSTART-1)-MSVAL-$(MSPEC,MSTOP+2,28-MSTOP) TO MSPEC
IF '@E@'$MSPEC

    * REMOVE FORMAT COMMAND CHARACTERS
    STORE $(MSPEC,1,@('@E@',MSPEC)-1) TO MSPEC1
    IF @('@E@',MSPEC)<28
       STORE MSPEC1+$(MSPEC,@('@E@',MSPEC)+3,30) TO MSPEC
    ELSE
       STORE MSPEC1 TO MSPEC
    ENDIF
    RELEASE MSPEC1

ENDIF

REPLACE SPEC:CODE WITH MSPEC
ENDIF




*FUNCTION: GENERATES THE TOLERANCE CODE LETTER FOR THE SPEC. AND INSERTS IT.

IF '<T>'$SPEC:CODE

STORE $(TOLERANCE,1,3) TO MTOL
DO CASE
   CASE &MTOL=0.1
        STORE 'B' TO MTOL
   CASE &MTOL=0.2
        STORE 'C' TO MTOL
   CASE &MTOL=0.5
        STORE 'D' TO MTOL
   CASE &MTOL=1.0
        STORE 'F' TO MTOL
   CASE &MTOL=2.0
        STORE 'G' TO MTOL
   CASE &MTOL=5.0
        STORE 'J' TO MTOL
   CASE &MTOL=10
        STORE 'K' TO MTOL
   OTHERWISE
        STORE '?' TO MTOL
ENDCASE

STORE SPEC:CODE TO MOPER
STORE @('<T>',MOPER) TO MSTART
STORE $(MOPER,1,MSTART-1)-MTOL-$(MOPER,MSTART+3,27-MSTART) TO MOPER
REPLACE SPEC:CODE WITH MOPER

ENDIF

STORE # TO OLD
CONTINUE
IF #=OLD
   SKIP
ENDIF
ENDDO
RETURN
«eof»