View source for Cruise

      * Display file entries like REVISE does (using file's DICT)
      * Written by Will Johnson
      * BE SURE TO INSTALL THE TCL.II INCLUDE BEFORE TRYING TO COMPILE THIS!
      *
      * Apply conversions if any to each multi-value
      * Use DICT VOC to control DICTs if specified
      * Don't display multi-value only fields
      * Use MCP to suppress non-printables
      * Allow edit as a command
      * Allow exploding one multi-valued field
      *
      EQUATE FALSE TO 0, TRUE TO 1
      TEST.MODE = FALSE
      $INCLUDE FFT.BP TCL.II
      GOSUB OPEN.FILES
      GOSUB GET.ITEMLIST
      GOSUB BUILD.DICT.TABLE
      IF TEST.MODE THEN GOSUB DISPLAY.DICT.TABLE
      FOR I.DICT.TABLE = 1 TO S.DICT.TABLE
         T.LABEL = DICT.TABLE<1,I.DICT.TABLE>
         IF T.LABEL = '' THEN T.LABEL = "<NO LABEL>"
      NEXT I.DICT.TABLE
      GOSUB PROCESS.RECORDS
      STOP
      *
      OPEN.FILES:
      OPEN 'VOC' TO F.VOC ELSE
         N.OFE = 'VOC' ; GOSUB OPEN.FILE.ERROR
      END
      K.VOC = "[[F2R]]"
      READ EXISTS FROM F.VOC,K.VOC ELSE
         R.VOC = "D":@AM:"2":@AM:@AM:"3R":@AM:"S"
         WRITE R.VOC ON F.VOC,K.VOC
      END
      RETURN
      *
      OPEN.FILE.ERROR:
      PRINT 'Cannot open file ':N.OFE:'. Hit ENTER':
      INPUT CONT ; STOP
      RETURN
      *
      GET.ITEMLIST:
      WORD.COUNT = DCOUNT(TRIMB(SENTENCE),' ')
      LAST.WORD = FIELD(TRIMB(SENTENCE),' ',WORD.COUNT)
      IF LAST.WORD[1,1] = '(' THEN
         OPTIONS.EXIST = TRUE ; OPTIONS = LAST.WORD[2,LEN(LAST.WORD)]
         WORD.COUNT -= 1
      END ELSE OPTIONS.EXIST = FALSE ; OPTIONS = ''
      IF C.WORD < WORD.COUNT THEN
         ITEM.SPECIFIED = TRUE
         SELECT.LIST = FALSE ; GROUPCODE = "G":(C.WORD-1):" 99"
         ITEM.LIST = OCONV(SENTENCE,GROUPCODE)
         CONVERT "'" TO "" IN ITEM.LIST
         CONVERT " " TO @AM IN ITEM.LIST
      END ELSE
         ITEM.SPECIFIED = FALSE
         READLIST LISTEXISTS THEN
            SELECT.LIST = TRUE ; SELECT LISTEXISTS
         END ELSE SELECT.LIST = FALSE
      END
      RETURN
      *
      * Select the DICT of the target file, or if already a DICT
      * then select the DICT VOC file, sorting it by field number
      * Then for each dict entry, if it's a D type and it's not the key
      *  to the file, and we haven't found a definition for this field
      *  number before then: we add the label to the field number
      *  position in the table line 1, and the conversion (if any) to
      *  the field number position in the table line 2.
      *
      BUILD.DICT.TABLE:
      IF DICT.FLAG THEN CMD = "VOC" ELSE CMD = N.FILE
      CMD = "SSELECT DICT ":CMD:" BY [[F2R]]"
      EXECUTE CMD, SELECT > DICT.LIST
      DICT.TABLE = '' ; DONE = FALSE ; LABEL.WIDTH = 0
      LOOP
         READNEXT DK.FILE FROM DICT.LIST ELSE DONE = TRUE
      UNTIL DONE DO
         READ DR.FILE FROM DF.FILE, DK.FILE THEN
            DICT.TYPE = DR.FILE<1>
            IF DICT.TYPE[1,1] = 'D' THEN
               IF NUM(DR.FILE<2>) AND DR.FILE<2> > 0 THEN
                  IF DICT.TABLE<2,DR.FILE<2>> = '' THEN
                     T.LABEL = DR.FILE<4>
                     CONVERT @VM TO ' ' IN T.LABEL
                     T.LABEL = TRIM(T.LABEL)
                     IF T.LABEL = '' THEN T.LABEL = DK.FILE
                     DICT.TABLE<1,DR.FILE<2>> = T.LABEL
                     L.LABEL = LEN(T.LABEL)
                     IF L.LABEL > LABEL.WIDTH THEN LABEL.WIDTH = L.LABEL
                     DICT.TABLE<2,DR.FILE<2>> = DR.FILE<3>
                  END
                  IF DR.FILE<7> # "" THEN
                     DICT.TABLE<3,DR.FILE<2>> = DR.FILE<7>
                  END
                  DICT.TABLE<4,DR.FILE<2>> = DK.FILE
               END
            END
         END
      REPEAT
      IF LABEL.WIDTH<10 THEN LABEL.WIDTH=10        ; *set min label wdt
      IF LABEL.WIDTH>35 THEN LABEL.WIDTH=35        ; *set max label wdt
      LEFT.JUST = "L#":LABEL.WIDTH ; RIGHT.JUST = "R#":LABEL.WIDTH
      S.DICT.TABLE = DCOUNT(DICT.TABLE<1>,@VM)
      RETURN
      *
      DISPLAY.DICT.TABLE:
      PRINT "NUM":" ":"FIELD DESC" ("L#":LABEL.WIDTH):" ":
      PRINT "CONVERSION":" ":"ASSOCIATION"
      FOR I.DICT.TABLE = 1 TO S.DICT.TABLE
         GOSUB DISPLAY.A.DICT.ENTRY
      NEXT I.DICT.TABLE
      PRINT "Hit ENTER. ": ; INPUT CONT
      RETURN
      *
      DISPLAY.A.DICT.ENTRY:
      PRINT I.DICT.TABLE"R%3":" ":
      PRINT DICT.TABLE<1,I.DICT.TABLE> ("L#":LABEL.WIDTH):" ":
      PRINT DICT.TABLE<2,I.DICT.TABLE>"L#8":" ":
      PRINT DICT.TABLE<3,I.DICT.TABLE>"L#12":" ":
      IF DICT.TABLE<4,I.DICT.TABLE> = '' THEN
         PRINT
      END ELSE
         PRINT DICT.TABLE<4,I.DICT.TABLE>
      END
      RETURN
      *
      PROCESS.RECORDS:
      IF TEST.MODE THEN
         IF SELECT.LIST THEN PRINT "SELECT ": ELSE PRINT "NO SELECT ":
         PRINT "LIST ACTIVE.  HIT ENTER": ; INPUT CONT
      END
      BEGIN CASE
         CASE SELECT.LIST ; NULL
         CASE ITEM.SPECIFIED ; SELECT ITEM.LIST
         CASE 1 ; SELECT F.FILE
      END CASE
      DONE = FALSE
      LOOP
         READNEXT K.FILE ELSE DONE = TRUE
      UNTIL DONE DO
      REREAD:
         READ R.FILE FROM F.FILE,K.FILE THEN
            PRINT @(-1): N.FILE:' ':K.FILE:' ':@LOGNAME
            S.FILE = DCOUNT(R.FILE,@AM) ; GOSUB PROCESS.ONE.RECORD
            IF UPCASE(FIELD(@LOGNAME,'\',2)) = "W.JOHNSON" THEN
               PRINT 'ENTER for next rec, E TO Edit, H for Help,':
               PRINT ' Q to stop, # to expand ':
               INPUT CONT
               BEGIN CASE
                  CASE CONT = 'Q'
                     CLEARSELECT ; STOP
                  CASE NUM(CONT)
                     BEGIN CASE
                        CASE CONT < 1 ; NULL
                        CASE CONT > S.FILE ; NULL
                        CASE CONT # INT(CONT) ; NULL
                        CASE 1 ; GOSUB EXPAND.FIELD
                     END CASE
                  CASE CONT = 'E'
                     EXECUTE "ED ":N.FILE:" ":K.FILE
                     GO REREAD
                  CASE CONT = 'H'
                     GOSUB HELP
               END CASE
            END
         END
      REPEAT
      RETURN
      *
      * Don't show me anything for fields with nothing in them. However:
      * If I have a field with something in it and NO corresponding
      *  Dict entry, then we show '<no label>' on that line.
      * So the size I walk through, is the size of the record itself
      * not the size of the Dict table I've here built.
      *
      * Don't show fields composed only of value-marks
      * Suppress non-printables, but tell me when I've done that
      PROCESS.ONE.RECORD:
      EXPLODE = FALSE
      FOR I.DICT.TABLE = 1 TO S.FILE
         GOSUB PROCESS.ONE.FIELD
      NEXT I.DICT.TABLE
      RETURN
      *
      PROCESS.ONE.FIELD:
      T.FILE = R.FILE<I.DICT.TABLE>
      * SKIP FIELD IF EMPTY OR ONLY VMS
      IF CONVERT(@VM,'',T.FILE) = '' THEN RETURN
      *
      IF EXPLODE THEN GOSUB DISPLAY.A.DICT.ENTRY
      GOSUB OUTPUT.LABEL
      GOSUB CONVERT.OUTPUT
      GOSUB SUPPRESS.CONTROL.CHARS
      *
      IF EXPLODE THEN
         CONVERT "_" TO @VM IN T.OUTPUT
         VALUE.WIDTH = 78-LABEL.WIDTH
         SPACE.PAD = SPACE(LABEL.WIDTH)
         S.T.OUTPUT = DCOUNT(T.OUTPUT,@VM)
         PRINT T.OUTPUT<1,1>
         FOR I.T.OUTPUT = 2 TO S.T.OUTPUT
            T.T.OUTPUT = T.OUTPUT<1,I.T.OUTPUT>
            PRINT SPACE.PAD:" (":I.DICT.TABLE"R%3":
            PRINT ".":I.T.OUTPUT"R%3":"): ": T.T.OUTPUT
         NEXT I.T.OUTPUT
      END ELSE
         CONVERT "_" TO "]" IN T.OUTPUT
         VALUE.WIDTH = 78-(LABEL.WIDTH + 8)
         SPACE.PAD = SPACE(78-VALUE.WIDTH)
         T.OUTPUT = FOLD(T.OUTPUT,VALUE.WIDTH)
         S.T.OUTPUT = DCOUNT(T.OUTPUT,@AM)
         PRINT T.OUTPUT<1>
         FOR I.T.OUTPUT = 2 TO S.T.OUTPUT
            PRINT SPACE.PAD: T.OUTPUT<I.T.OUTPUT>
         NEXT I.T.OUTPUT
      END
      RETURN
      *
      OUTPUT.LABEL:
      T.LABEL = DICT.TABLE<1,I.DICT.TABLE>
      IF T.LABEL = '' THEN T.LABEL = '<no label>'
      IF LEN(T.LABEL) > LABEL.WIDTH THEN
         PRINT T.LABEL LEFT.JUST:
      END ELSE
         PRINT T.LABEL RIGHT.JUST:
      END
      IF EXPLODE THEN
         PRINT " (":I.DICT.TABLE"R%3":".001":"):":
      END ELSE
         PRINT " (":I.DICT.TABLE"R%3":"):":
      END
      RETURN
      *
      CONVERT.OUTPUT:
      T.CONV = DICT.TABLE<2,I.DICT.TABLE>
      S.T.FILE = DCOUNT(T.FILE,@VM) ; T.OUTPUT = ''
      FOR I.T.FILE = 1 TO S.T.FILE
         T.OUTPUT<1,I.T.FILE> = OCONV(T.FILE<1,I.T.FILE>,T.CONV)
      NEXT I.T.FILE
      CONVERT @VM TO "_" IN T.OUTPUT
      RETURN
      *
      SUPPRESS.CONTROL.CHARS:
      CT.OUTPUT = OCONV(T.OUTPUT,'MCP')  ; *REM NON-PRINTABLES
      IF CT.OUTPUT = T.OUTPUT THEN PRINT " ": ELSE
         PRINT ".": ; T.OUTPUT = CT.OUTPUT
      END
      RETURN
      *
      EXPAND.FIELD:
      EXPLODE = TRUE
      I.DICT.TABLE = CONT
      GOSUB PROCESS.ONE.FIELD
      PRINT 'Hit ENTER, or Q TO STOP ': ; INPUT CONT
      IF CONT = 'Q' THEN STOP
      RETURN
      *
      HELP:
      PRINT "Help doesn't yet work, press ENTER": ; INPUT CONT
      RETURN
      *
   END