190 lines
6.6 KiB
Brainfuck
Executable File
190 lines
6.6 KiB
Brainfuck
Executable File
******************************************************************************
|
|
*
|
|
* PRINT.RECORD subroutine for PI/open COPY verb
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenance log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 10/17/95 15321 SHJ Fix output when field number is greater than 10000
|
|
* 04/28/95 16448 LDG Added UNICODE version of HEX.SW for NLS.
|
|
* 03/28/95 13618 SHK Fix spacing problems with CRT
|
|
* 07/30/93 10871 WLG Fix CRT for null fields not to print space.
|
|
* 07/16/93 10871 EAP Minor changes for Universe compatibility
|
|
* 06/25/93 10871 EAP Ported PI/open COPY verb to Universe
|
|
*******************************************************************************
|
|
*
|
|
* START-DESCRIPTION :
|
|
*
|
|
* This subroutine prints one record on the terminal or printer, in the
|
|
* format required by the COPY and LIST.ITEM verbs. It is called as
|
|
* follows:
|
|
*
|
|
* CALL -PRINT.RECORD( RECORD.ID, RECORD, LPTR.NO, LPTR.WIDTH,
|
|
* NUM.SUPPRESS.FLAG, ID.SUPPRESS.FLAG, HEX.SW)
|
|
*
|
|
* Arguments (all input):
|
|
*
|
|
* RECORD.ID The ID of the record to be printed.
|
|
*
|
|
* RECORD The text of the record to be printed.
|
|
*
|
|
* LPTR.NO The printunit on which to print. If terminal
|
|
* output is required, LPTR.NO should be set to
|
|
* zero, and PRINTER OFF should be in effect.
|
|
*
|
|
* LPTR.WIDTH The effective line width of the output device,
|
|
* i.e. the actual device width LESS any margin
|
|
* that may be in effect.
|
|
*
|
|
* NUM.SUPPRESS.FLAG If true, the line numbers which normally appear
|
|
* on the output will be suppressed.
|
|
*
|
|
* ID.SUPPRESS.FLAG If true, the record ID, which is otherwise
|
|
* output before the text of the record, will be
|
|
* suppressed.
|
|
*
|
|
* HEX.SW If >0, the text of the record will be output
|
|
* in hexadecimal (using MX0C conversion).
|
|
* If -1, the text will be output in Unicode 4-digit
|
|
* hexadecimal format (using MU0C conversion).
|
|
*
|
|
* END-DESCRIPTION
|
|
*
|
|
* START-DESIGN:
|
|
*
|
|
* END-DESIGN
|
|
*
|
|
* START-FUTURES:
|
|
*
|
|
* 1. The OCONV for the HEX option will only convert input strings up to
|
|
* 93 characters. LOOP required to feed OCONV substrings and conactenate
|
|
* the output.
|
|
*
|
|
* END-FUTURES
|
|
*
|
|
* START-CODE:
|
|
*
|
|
* START-LOCALIZATION
|
|
*
|
|
* END-LOCALIZATION
|
|
*
|
|
SUBROUTINE PRINT.RECORD (RECORD.ID, RECORD, LPTR.NO, LPTR.WIDTH,
|
|
NUM.SUP.SW, ID.SUP.SW, HEX.SW)
|
|
*
|
|
*
|
|
INDENT = 5 ;* EG. '0001 '
|
|
IF LPTR.WIDTH <= INDENT THEN LINE.SPLIT = 80
|
|
ELSE LINE.SPLIT = LPTR.WIDTH
|
|
IF NOT(NUM.SUP.SW) THEN
|
|
LINE.SPLIT -= INDENT
|
|
END
|
|
IF NOT(ID.SUP.SW) THEN
|
|
PRINT ON LPTR.NO ' ' :RECORD.ID
|
|
END
|
|
|
|
DISPLAY.LINE.LENGTH = 0
|
|
MAX.FIELD.COUNT = DCOUNT(RECORD,@FM)
|
|
*
|
|
* Process all fields in record.
|
|
FOR FIELD.COUNT = 1 TO MAX.FIELD.COUNT
|
|
|
|
BEGIN CASE
|
|
CASE HEX.SW > 0
|
|
RECORD.FIELD = OCONV(RECORD<FIELD.COUNT>,"MX0C")
|
|
* Ensure also that line split is multiple of 2, so that a
|
|
* hex character is not displayed split across a line:
|
|
LINE.SPLIT -= MOD(LINE.SPLIT, 2)
|
|
CASE HEX.SW = -1 ;* (don't use < 0, as HEX.SW can be '')
|
|
* Unicode form wanted - caller should have checked NLS is on:
|
|
RECORD.FIELD = OCONV(RECORD<FIELD.COUNT>,"MU0C")
|
|
* Ensure also that line split is multiple of 4, so that a
|
|
* Unicode character is not displayed split across a line:
|
|
LINE.SPLIT -= MOD(LINE.SPLIT, 4)
|
|
CASE 1
|
|
RECORD.FIELD = RECORD<FIELD.COUNT>
|
|
END CASE
|
|
|
|
IF NOT(NUM.SUP.SW)
|
|
THEN
|
|
IF FIELD.COUNT < 10000 THEN
|
|
LINE.NO.DISPLAY = FMT(FIELD.COUNT, "4'0'R"):' '
|
|
END ELSE
|
|
LINE.NO.DISPLAY = FMT(FIELD.COUNT, "5'0'R"):' '
|
|
END
|
|
END ELSE
|
|
LINE.NO.DISPLAY = ''
|
|
END
|
|
|
|
*
|
|
* Split field if required. FMT will split the line up by inserting
|
|
* text marks into the string ...
|
|
*
|
|
|
|
ORIGINAL.TEXT.MARKS = COUNT(RECORD.FIELD, @TM)
|
|
IF RECORD.FIELD # "" THEN
|
|
RECORD.TEMP = FMT(RECORD.FIELD, LINE.SPLIT : "L")
|
|
END ELSE
|
|
RECORD.TEMP = ""
|
|
END
|
|
TEXT.MARK.SEPARATED.FIELDS = DCOUNT(RECORD.TEMP, @TM)
|
|
|
|
*
|
|
* Now process string, we are ONLY interested in text marks, all
|
|
* other marks should be ignored and left in the string. Also we
|
|
* are only interested in text marks which have been put there by
|
|
* FMT, others should be ignored and left. Use DISLEN to check the
|
|
* text marks.
|
|
*
|
|
|
|
DISPLAY.LINE = FIELD(RECORD.TEMP, @TM, 1)
|
|
IF ORIGINAL.TEXT.MARKS EQ 0
|
|
THEN
|
|
PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(DISPLAY.LINE)
|
|
IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = ' '
|
|
END
|
|
|
|
FOR LOOP.COUNTER = 2 TO TEXT.MARK.SEPARATED.FIELDS
|
|
LINE.CHUNK = FIELD(RECORD.TEMP, @TM, LOOP.COUNTER)
|
|
IF ORIGINAL.TEXT.MARKS EQ 0
|
|
THEN
|
|
PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(LINE.CHUNK)
|
|
IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = ' '
|
|
END ELSE
|
|
DISPLAY.LINE.LENGTH= LEN(DISPLAY.LINE:@TM:LINE.CHUNK)
|
|
IF DISPLAY.LINE.LENGTH GT LINE.SPLIT
|
|
THEN
|
|
PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(DISPLAY.LINE)
|
|
IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = ' '
|
|
DISPLAY.LINE = LINE.CHUNK
|
|
END ELSE
|
|
DISPLAY.LINE := @TM:LINE.CHUNK
|
|
END
|
|
END
|
|
NEXT LOOP.COUNTER
|
|
|
|
IF ORIGINAL.TEXT.MARKS NE 0
|
|
THEN
|
|
PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(DISPLAY.LINE)
|
|
IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = ' '
|
|
END
|
|
|
|
NEXT FIELD.COUNT
|
|
|
|
* PRINT ON LPTR.NO
|
|
|
|
RETURN
|
|
|
|
END
|
|
*
|
|
* END-CODE
|