137 lines
4.6 KiB
Plaintext
Executable File
137 lines
4.6 KiB
Plaintext
Executable File
********************************************************************************
|
|
*
|
|
* Print large block letters to either the terminal or printer
|
|
*
|
|
* 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.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenence log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 09/19/90 7476 JWT fix bug in getting page width
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
|
*
|
|
*******************************************************************************
|
|
|
|
$OPTIONS DEFAULT
|
|
|
|
EQU MAX.FORMAT TO 50
|
|
NUM.TOKENS.TO.START = 30
|
|
LINES.BETWEEN.WORDS = 2
|
|
SPACE.BETWEEN.LETTERS = 3
|
|
DIM FORMT(MAX.FORMAT) ;* ARRAY OF CHARACTER FORMATS.
|
|
DIM WORDS(NUM.TOKENS.TO.START) ;* FOR PARSING SENTENCE.
|
|
DUMMY = @(0,0) ;* TURN OFF PAGING.
|
|
|
|
OPEN 'BLTRS' TO FILE ELSE
|
|
@SYSTEM.RETURN.CODE = -1
|
|
STOP 'No "BLTRS" file available.'
|
|
END
|
|
TOTAL.WIDTH = 0
|
|
PRT = ''
|
|
@SYSTEM.RETURN.CODE = 0
|
|
|
|
*
|
|
SENTENCE = FIELD(@SENTENCE, ' ' , 2, 9999)
|
|
|
|
IF SENTENCE = '' THEN RETURN
|
|
IF @OPTION = 'LPTR' THEN PRT = 1
|
|
LOOP
|
|
MATPARSE WORDS FROM SENTENCE, ' '
|
|
UNTIL INMAT() DO ;* TOO MANY TOKENS SO FAR, INCREASE THE AMOUNT ALLOWED.
|
|
NUM.TOKENS.TO.START = NUM.TOKENS.TO.START * 2 ;* DOUBLE THE SIZE
|
|
DIM WORDS(NUM.TOKENS.TO.START)
|
|
REPEAT
|
|
IF PRT THEN
|
|
PRINTER ON
|
|
PAGE.WIDTH = @LPTRWIDE ;* PAGE WIDTH
|
|
END ELSE
|
|
PRINT @( - 1)
|
|
PAGE.WIDTH = @CRTWIDE ;* PAGE WIDTH
|
|
END
|
|
ANY.PRINTING.YET = ''
|
|
FOR L = 1 TO INMAT()
|
|
IF ANY.PRINTING.YET THEN
|
|
FOR P = 1 TO LINES.BETWEEN.WORDS
|
|
PRINT
|
|
NEXT P
|
|
NUM.LINES.LEFT = SYSTEM(4)
|
|
IF (NUM.LINES.LEFT < 9) THEN ;* WE NEED 9 LINES TO PRINT A
|
|
;* WORD
|
|
PAGE
|
|
ANY.PRINTING.YET = ''
|
|
END
|
|
END
|
|
WORD = WORDS(L)
|
|
IF LEN(WORD) > MAX.FORMAT THEN
|
|
WORD = WORD[1,MAX.FORMAT]
|
|
END
|
|
FOR K = 1 TO LEN(WORD)
|
|
READ FORMT(K) FROM FILE, WORD[K, 1] ELSE
|
|
PRINTER OFF
|
|
PRINT 'Character "' : WORD[K, 1] : '" not found.'
|
|
@SYSTEM.RETURN.CODE = -1
|
|
RETURN
|
|
END
|
|
WIDTH = EXTRACT(FORMT(K), 1, 0, 0)
|
|
IF NOT(NUM(WIDTH)) THEN GO FORMAT.ERROR
|
|
TOTAL.WIDTH += WIDTH + SPACE.BETWEEN.LETTERS
|
|
NEXT K
|
|
TOTAL.WIDTH -= SPACE.BETWEEN.LETTERS
|
|
IF TOTAL.WIDTH >= PAGE.WIDTH THEN
|
|
PRINTER OFF
|
|
PRINT 'The word "':WORD:'" is too long.'
|
|
@SYSTEM.RETURN.CODE = -1
|
|
TOTAL.WIDTH = 0
|
|
IF PRT THEN PRINTER ON
|
|
END
|
|
ELSE
|
|
PAD = (PAGE.WIDTH - TOTAL.WIDTH) / 2
|
|
TOTAL.WIDTH = 0
|
|
FOR I = 2 TO 10
|
|
PRINT STR( ' ' , PAD) :
|
|
FOR K = 1 TO LEN(WORD)
|
|
LINE = EXTRACT(FORMT(K), I, 0, 0)
|
|
IF LINE[1, 1] NE 'C' AND LINE[1, 1] NE 'B' THEN
|
|
GOTO FORMAT.ERROR
|
|
END
|
|
IF LINE[1, 1] = 'C' THEN CHAR1 = WORD[K, 1] ; CHAR2 = ' '
|
|
IF LINE[1, 1] = 'B' THEN CHAR1 = ' '; CHAR2 = WORD[K, 1]
|
|
LINE = LINE[2, 99]
|
|
FOR J = 1 TO 7
|
|
FIELD1 = EXTRACT(LINE, 1, J, 0)
|
|
IF FIELD1 = '' THEN GO 20
|
|
IF MOD(J, 2) THEN PRINT STR(CHAR1, FIELD1) :
|
|
ELSE PRINT STR(CHAR2, FIELD1) :
|
|
20 NEXT J
|
|
FOR P = 1 TO SPACE.BETWEEN.LETTERS
|
|
PRINT ' ' :
|
|
NEXT P
|
|
NEXT K
|
|
PRINT
|
|
NEXT I
|
|
ANY.PRINTING.YET = 1
|
|
END
|
|
NEXT L
|
|
IF PRT THEN
|
|
IF ANY.PRINTING.YET THEN PAGE
|
|
PRINTER OFF
|
|
END
|
|
RETURN
|
|
STOP
|
|
|
|
FORMAT.ERROR:
|
|
PRINTER OFF
|
|
@SYSTEM.RETURN.CODE = -1
|
|
STOP 'Format error in "BLTRS" file, item "' : WORD[K, 1] : '"'
|
|
|
|
|
|
END
|