MakeDict

From Pickwiki
Jump to: navigation, search

Back to BasicSource

This program lists, amends, or creates a dictionary from a command line input. It uses defined keywords to figure out what to do - the help is



 SYNTAX: MAKEDICT [DICT] FILE ITEM [OPTIONS] [OVERWRITING]

OPTIONS: Each option is followed by a string defining it

   AS   - Dictionary type (A, S, D, I or V)
   LNUM - Attribute number (A, S, and D types)
   CALC - I-type (I,V) or correlative (A,S,D)
   CONV - Conversion
   FMT  - length and Justification
   ASSOC - Associated multivalue string
   MULTI-VALUE  - M or Y for multivalues, otherwise single
   DISPLAY.NAME - Column heading for reports

   OVERWRITING means that changes are made without prompting

and the code is

  PROGRAM MAKEDICT

* ECL - KRJ - Program to create or change a dictionary item

  OPEN 'VOC' TO VOC ELSE
    OPEN 'MD' TO VOC ELSE STOP 201,'VOC'
  END
  PROMPT ''

* Set up keywords
*
  DICTK = '20'  ;* DICT keyword
  TYPEK = '260' ;* AS keyword
  LNUMK = '269' ;* LNUM keyword
  CALCK = '38'  ;* CALC keyword
  CONVK = '301' ;* CONVERSION keyword
  DISPK = '304' ;* DISPLAY.NAME keyword
  FORMK = '276' ;* FMT keyword
  MULTK = '306' ;* MULTI-VALUE keyword
  ASSOK = '302' ;* ASSOC keyword
  OVERK = '34'  ;* OVERWRITING keyword

$IFDEF QM
  DICTK = '1'    ;* DICT keyword
  TYPEK = '60'  ;* AS keyword
  LNUMK = '153' ;* LNUM keyword
  CALCK = '74'  ;* CALC keyword
  CONVK = '64'  ;* CONVERSION keyword
  DISPK = '57'  ;* DISPLAY.NAME keyword
  FORMK = '58'  ;* FMT keyword
  MULTK = '93'   ;* MULTI-VALUE keyword
  ASSOK = '126' ;* ASSOC keyword
  OVERK = '16'  ;* OVERWRITING keyword
$ENDIF

* Parse the command line - anything in quotes or brackets one thing
*
  BITE = ''
  FLAG = ''
  ATTR = 1
  LONG = LEN(@SENTENCE)
  FOR HERE = 1 TO LONG
    THIS = @SENTENCE[HERE,1]
    IF FLAG EQ '' THEN
      IF THIS = ' ' THEN
        IF BITE<ATTR> NE '' THEN ATTR += 1
      END ELSE
        IF INDEX('"\':"'",THIS,1) THEN
          FLAG = THIS
        END ELSE
          IF THIS = '(' THEN
            FLAG = ')'
            IF BITE<ATTR> NE '' THEN ATTR += 1
            BITE<ATTR> = '('
          END ELSE BITE<ATTR> = BITE<ATTR>:THIS
        END
      END
    END ELSE
      IF THIS NE FLAG THEN
        BITE<ATTR> = BITE<ATTR>:THIS
      END ELSE
        IF THIS = ')' THEN BITE<ATTR> = BITE<ATTR>:THIS
        ATTR += 1
        FLAG = ''
      END
    END
  NEXT HERE

* Check if we are running this - if so we delete first two
  IF UPCASE(BITE<1>) EQ 'RUN' THEN
    DEL BITE<1>
    DEL BITE<1>
  END

* Delete the verb
  DEL BITE<1>

* Get the file, checking for DICT before file name
  NAME = BITE<1>
  DEL BITE<1>
  READ VREC FROM VOC, NAME ELSE VREC = ''
  IF VREC<1>[1,1] EQ 'K' AND VREC<2> EQ DICTK THEN
    NAME = BITE<1>
    DEL BITE<1>
  END

* Get the item we want to display or amend or create
  ITEM = BITE<1>
  DEL BITE<1>

* If we don't have an item, show help
  IF ITEM EQ '' THEN
    CRT
    CRT ' SYNTAX: MAKEDICT [DICT] FILE ITEM [OPTIONS] [OVERWRITING]'
    CRT
    CRT 'OPTIONS: Each option is followed by a string defining it'
    CRT
    CRT '   AS   - Dictionary type (A, S, D, I or V)'
    CRT '   LNUM - Attribute number (A, S, and D types)'
    CRT '   CALC - I-type (I,V) or correlative (A,S,D)'
    CRT '   CONV - Conversion'
    CRT '   FMT  - length and Justification    '
    CRT '   ASSOC - Associated multivalue string'
    CRT '   MULTI-VALUE  - M or Y for multivalues, otherwise single'
    CRT '   DISPLAY.NAME - Column heading for reports'
    CRT
    CRT '   OVERWRITING means that changes are made without prompting'
    CRT
    STOP
  END

  OPEN 'DICT',NAME TO DFIL ELSE
    CRT 'Cannot open dictionary of file "':NAME:'"'
    STOP
  END

  READ DREC FROM DFIL, ITEM ELSE DREC = ''
  ORIG = DREC
  TYPE = TRIM(DREC<1>)

* See if we just want to look at it
  IF BITE EQ '' THEN
    GOSUB SHOWDICT
    STOP
  END

* Initialise the bits and bobs
  TYPE = ''
  LNUM = ''
  CALC = ''
  CONV = ''
  DISP = ''
  FORM = ''
  MULT = ''
  ASSO = ''
  OVER = @FALSE

* Process the input
*
  ACNT = DCOUNT(BITE,@AM)
  FOR ANUM = 1 TO ACNT
    WORD = BITE<ANUM>
    READ VREC FROM VOC, WORD ELSE CONTINUE
    IF UPCASE(TRIM(VREC<1>)[1,1]) NE 'K' THEN CONTINUE
    THIS = TRIM(VREC<2>)
    BEGIN CASE
      CASE THIS EQ TYPEK
        ANUM += 1 ; TYPE = BITE<ANUM>
        TEST = UPCASE(TRIM(TYPE))[1,1]
        IF NOT(TEST MATCHES '1A') THEN
          CRT '"':TYPE:'" is an invalid Type'
          STOP
        END
        IF NOT(INDEX('ADISV',TEST,1)) THEN
          CRT '"':TYPE:'" is a wrong Type'; STOP
        END
      CASE THIS EQ LNUMK
        ANUM += 1; LNUM = BITE<ANUM>
        IF NOT(LNUM MATCHES '1[[N0N]]') AND LNUM THEN
          CRT '"':LNUM:'" is an invalid number'
          STOP
        END
      CASE THIS EQ CALCK
        ANUM += 1; CALC = BITE<ANUM>
        IF CALC EQ '' THEN CALC = @AM
      CASE THIS EQ CONVK
        ANUM += 1; CONV = BITE<ANUM>
        IF CONV EQ '' THEN CONV = @FM
      CASE THIS EQ DISPK
        ANUM += 1; DISP = BITE<ANUM>
        IF DISP EQ '' THEN DISP = @AM
      CASE THIS EQ FORMK
        ANUM += 1; FORM = BITE<ANUM>
        GOOD = @FALSE
        IF FORM MATCHES "0[[N1X]]'L'0X" THEN GOOD = @TRUE
        IF FORM MATCHES "0[[N1X]]'R'0X" THEN GOOD = @TRUE
        IF FORM MATCHES "0[[N1X]]'T'0X" THEN GOOD = @TRUE
        IF FORM MATCHES "0N'L'0X" THEN GOOD = @TRUE
        IF FORM MATCHES "0N'R'0X" THEN GOOD = @TRUE
        IF FORM MATCHES "0N'T'0X" THEN GOOD = @TRUE
        IF FORM MATCHES "'X'0[[N0X]]" THEN GOOD = @TRUE
        IF NOT(GOOD) THEN
          CRT '"':FORM:'" is an invalid Format'
          STOP
        END
      CASE THIS EQ MULTK
        ANUM += 1 ; MULT = BITE<ANUM>
        MULT = UPCASE(TRIM(MULT))[1,1]
        IF MULT EQ 'M' OR MULT EQ 'Y'
          THEN MULT = 'M'
          ELSE MULT = 'S'
      CASE THIS EQ ASSOK
        ANUM += 1; ASSO = BITE<ANUM>
        IF ASSO = '' THEN ASSO = @AM
      CASE THIS EQ OVERK
        OVER = @TRUE
    END CASE
  NEXT ANUM

* Change whatever we want to
*
  IF TYPE NE '' THEN DREC<1> = TYPE
  THIS = UPCASE(TRIM(DREC<1,1>))[1,1]
  BEGIN CASE
    CASE THIS EQ 'I' OR THIS EQ 'V'
      IF CALC NE '' THEN THAT = CALC; PART = 2; GOSUB REPLACE
      IF CONV NE '' THEN THAT = CONV; PART = 3; GOSUB REPLACE
      IF DISP NE '' THEN THAT = DISP; PART = 4; GOSUB REPLACE
      IF FORM NE '' THEN DREC<5> = FORM
      IF MULT NE '' THEN DREC<6> = MULT
      IF ASSO NE '' THEN THAT = ASSO; PART = 7; GOSUB REPLACE
    CASE THIS EQ 'D'
      IF LNUM NE '' THEN DREC<2> = LNUM
      IF CONV NE '' THEN THAT = CONV; PART = 3; GOSUB REPLACE
      IF DISP NE '' THEN THAT = DISP; PART = 4; GOSUB REPLACE
      IF FORM NE '' THEN DREC<5> = FORM
      IF MULT NE '' THEN DREC<6> = MULT
      IF ASSO NE '' THEN THAT = ASSO; PART = 7; GOSUB REPLACE
    CASE THIS EQ 'A' OR THIS EQ 'S'
      IF LNUM NE '' THEN DREC<2> = LNUM
      IF DISP NE '' THEN THAT = DISP; PART = 3; GOSUB REPLACE
      IF ASSO NE '' THEN THAT = ASSO; PART = 4; GOSUB REPLACE
      IF CONV NE '' THEN THAT = CONV; PART = 7; GOSUB REPLACE
      IF CALC NE '' THEN THAT = CALC; PART = 8; GOSUB REPLACE
      IF FORM NE '' THEN
        GOOD = @FALSE
        TEST = OCONV(FORM,'MCA')
        IF TEST EQ 'R' OR TEST EQ 'L' OR TEST EQ 'T' THEN
          NUMB = FIELD(FORM,TEST,1)
          IF NUMB EQ '' THEN NUMB = FIELD(FORM,TEST,2)
          IF NUMB MATCHES '1[[N0N]]' THEN
            DREC<9> = TEST
            DREC<10> = NUMB
            GOOD = @TRUE
          END
        END
        IF NOT(GOOD) THEN
          CRT '"':FORM:'" is an invalid Format'
          STOP
        END
      END
    CASE 1
      CRT 'Cannot find type ':DREC<1>
      STOP
  END CASE

  IF ORIG EQ DREC THEN
    CRT 'Nothing Changed'
    STOP
  END

  IF OVER THEN
    WRITE DREC ON DFIL, ITEM
    CRT 'Changes made'
    STOP
  END

  GOSUB SHOWDICT
  CRT
  CRT 'OK to update this?':
  INPUT ANSW
  ANSW = UPCASE(TRIM(ANSW))[1,1]
  IF ANSW EQ 'Y' THEN WRITE DREC ON DFIL, ITEM

  STOP

************
* Subroutines
*************
SHOWDICT:
  CRT
  CRT NAME,ITEM,' ':
  THIS = UPCASE(TRIM(DREC<1>))[1,1]
  BEGIN CASE
    CASE DREC EQ ''
      CRT 'Dictionary is empty'
    CASE THIS = 'I' OR THIS EQ 'V'
      CRT 'I-type'
      CRT ' TYPE: ':DREC<1>
      CRT 'ITYPE: ':DREC<2>
      CRT ' CONV: ':DREC<3>
      CRT ' NAME: ':DREC<4>
      CRT '  FMT: ':DREC<5>
      CRT '  S[[/M]]: ':DREC<6>
      CRT 'ASSOC: ':DREC<7>
    CASE THIS EQ 'D'
      CRT 'Prime style'
      CRT ' TYPE: ':DREC<1>
      CRT ' ATTR: ':DREC<2>
      CRT ' CONV: ':DREC<3>
      CRT ' NAME: ':DREC<4>
      CRT '  FMT: ':DREC<5>
      CRT '  S[[/M]]: ':DREC<6>
      CRT 'ASSOC: ':DREC<7>
    CASE THIS EQ 'A' OR TYPE EQ 'S'
      CRT 'Pick style'
      CRT '  TYPE: ':DREC<1>
      CRT '  ATTR: ':DREC<2>
      CRT '  NAME: ':DREC<3>
      CRT ' ASSOC: ':DREC<4>
      CRT '  CONV: ':DREC<7>
      CRT '  CORR: ':DREC<8>
      CRT '  JUST: ':DREC<9>
      CRT 'LENGTH: ':DREC<10>
    CASE 1
      CRT 'UNKNOWN DICTIONARY TYPE'
      ACNT = DCOUNT(DREC,@AM)
      IF ACNT GT 12 THEN ACNT = 12
      FOR ANUM = 1 TO ACNT
        CRT ACNT 'R#3':' ':OCONV(DREC<ANUM>,'MCP')
      NEXT ANUM
  END CASE
  RETURN

REPLACE:
* The @AM is to allow a field to be nulled
  IF THAT EQ @AM
    THEN DREC<PART> = ''
    ELSE DREC<PART> = THAT
  RETURN