#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# README		    bc.4gl		pcl.4gl		    ps.4gl
#
# This shell archive created: Fri Aug 28 09:46:28 CDT 1998
#
echo "Extracting file README"
sed -e 's/^X//' <<\SHAR_EOF > README
Xbc.4gl  - code for barcodes
Xpcl.4gl - code for HP PCL codes
Xps.4gl  - code for postscript printers
SHAR_EOF
if [ `wc -c < README` -ne       99 ]
then
    echo "Lengths do not match -- Bad Copy of README"
fi
echo "Extracting file bc.4gl"
sed -e 's/^X//' <<\SHAR_EOF > bc.4gl
X#
X# Filename: bc.4gl
X# Desc    : Barcodes on Laser Printers
X# SCCS    : @(#) bc.4gl 1.1 96/04/18 15:33:10
X# Author  : Ti Lian Hwang (tilh@sin-co.sg.dhl.com)
X# Date    : 04 Oct 95
X# 
X# FUNCTION lj_barcode(xpos,ypos,str,x,y)		
X#		draws barcode at (xpos,ypos) with values of str
X#               of size x,y (all units in inches from bottom-right)
X#
X# FUNCTION lj_PrintThis(str)			- internal function
X# FUNCTION lj_PutBars(c)				- internal function
X# FUNCTION lj_BarChar(mapstring)			- internal function
X#
X# Amended :
X# Initials   Amend date   Version    Description of amendment
X#   tilh     04 Oct 95    1.00       initial implementation with 4GL
X#                                    from original by Dennis Taylor
X#
X# The following code produces CODE 39 barcodes on an Postscript. There are
X# several different barcode standards, but these days most barcode readers
X# will read all the major ones.
X#
X# In CODE 39, each character consists of 9 bars, 5 of which are black, and
X# 4 of which are white (the gaps are considered bars). 3 of the 9 are thick
X# bars (thus code 39), and 6 are thin. there is a thin gap between each
X# character. every bar code starts and ends with an asterisk, which is
X# generally accepted as the delimiter character.
X#
X# the ratio of thick to thin is supposed to be in the range 2:1 to 3:1. i
X# find that 2.5:1 works well.
X#
X
XDEFINE atx,aty SMALLINT
XDEFINE ysize SMALLINT
XDEFINE littlebar SMALLINT
XDEFINE bigbar SMALLINT
X
XFUNCTION lj_bc_sccs ()
XDEFINE s CHAR(16)
XLET s = "@(#)bc.4gl	1.1\t04/18/96"	# sccs
XEND FUNCTION
X
XFUNCTION lj_barcode(xpos,ypos,str,x,y)
XDEFINE str CHAR(64)
XDEFINE xpos,ypos,bar_length,x,y SMALLFLOAT
XDEFINE i SMALLINT
XDEFINE char_length SMALLINT
XDEFINE font_size SMALLFLOAT
XDEFINE bar_scale SMALLFLOAT
X
XLET littlebar=8 	# these numbers are arbitrary, as long as the ratio
XLET bigbar=20		# stays between 2:1 and 3:1
X
X	LET ysize = y * 72.0		# inch to points
X	LET font_size = y * 14.4	# 2/10 of height of bar
X	LET aty = y * 14.4		# 2/10 of height of bar
X	LET atx = 0
X	LET char_length = 3 * bigbar + 6 * littlebar
X
X	LET i = LENGTH (str) + 2				# delimiters
X	LET bar_length = char_length * i + (i-1) * littlebar	# gap
X
X	LET bar_scale = (72.0 * x) / bar_length
X	CALL lj_InitBar(xpos,ypos,x,y,font_size,bar_scale)
X
X	CALL lj_PrintThis(UPSHIFT(str))
X
X	CALL lj_TermBar()
XEND FUNCTION
X
X#
X# given an asciiz string, do what's necessary. tack on delimiter '*'s
X#
XFUNCTION lj_PrintThis(str)
X
X        DEFINE str CHAR(64)
X	DEFINE x SMALLINT
X
X        CALL lj_PutBars('*')   # starting delimiter */
X        FOR x=1 TO LENGTH(str)
X
X		CALL lj_PrintChar (atx,str[x,x])
X                CALL lj_PutBars(str[x,x])     # do each char */
X
X        END FOR
X        CALL lj_PutBars('*')   # ending delimiter */
XEND FUNCTION
X
X#
X# determine the actual thick/thin pattern for the submitted character
X#
XFUNCTION lj_PutBars(c)
X	DEFINE c CHAR
X        
X	CASE (c)
X                WHEN '0'	CALL lj_BarChar("000110100")
X                WHEN '1'	CALL lj_BarChar("100100001")
X                WHEN '2'	CALL lj_BarChar("001100001")
X                WHEN '3'	CALL lj_BarChar("101100000")
X                WHEN '4'	CALL lj_BarChar("000110001")
X                WHEN '5'	CALL lj_BarChar("100110000")
X                WHEN '6'	CALL lj_BarChar("001110000")
X                WHEN '7'	CALL lj_BarChar("000100101")
X                WHEN '8'	CALL lj_BarChar("100100100")
X                WHEN '9'	CALL lj_BarChar("001100100")
X                WHEN '-'	CALL lj_BarChar("010000101")
X                WHEN '.'	CALL lj_BarChar("110000100")
X                WHEN ' '	CALL lj_BarChar("011000100")
X                WHEN '+'	CALL lj_BarChar("010001010")
X                WHEN '%'	CALL lj_BarChar("000101010")
X                WHEN '$'	CALL lj_BarChar("010101000")
X                WHEN '/'	CALL lj_BarChar("010100010")
X                WHEN 'A'	CALL lj_BarChar("100001001")
X                WHEN 'B'	CALL lj_BarChar("001001001")
X                WHEN 'C'	CALL lj_BarChar("101001000")
X                WHEN 'D'	CALL lj_BarChar("000011001")
X                WHEN 'E'	CALL lj_BarChar("100011000")
X                WHEN 'F'	CALL lj_BarChar("001011000")
X                WHEN 'G'	CALL lj_BarChar("000001101")
X                WHEN 'H'	CALL lj_BarChar("100001100")
X                WHEN 'I'	CALL lj_BarChar("001001100")
X                WHEN 'J'	CALL lj_BarChar("000011100")
X                WHEN 'K'	CALL lj_BarChar("100000011")
X                WHEN 'L'	CALL lj_BarChar("001000011")
X                WHEN 'M'	CALL lj_BarChar("101000010")
X                WHEN 'N'	CALL lj_BarChar("000010011")
X                WHEN 'O'	CALL lj_BarChar("100010010")
X                WHEN 'P'	CALL lj_BarChar("001010010")
X                WHEN 'Q'	CALL lj_BarChar("000000111")
X                WHEN 'R'	CALL lj_BarChar("100000110")
X                WHEN 'S'	CALL lj_BarChar("001000110")
X                WHEN 'T'	CALL lj_BarChar("000010110")
X                WHEN 'U'	CALL lj_BarChar("110000001")
X                WHEN 'V'	CALL lj_BarChar("011000001")
X                WHEN 'W'	CALL lj_BarChar("111000000")
X                WHEN 'X'	CALL lj_BarChar("010010001")
X                WHEN 'Y'	CALL lj_BarChar("110010000")
X                WHEN 'Z'	CALL lj_BarChar("011010000")
X                OTHERWISE	CALL lj_BarChar("010010100")
X        END CASE
XEND FUNCTION
X
X#
X# given the thick/thin map of 9 0's and 1's, order up some rectangles
X# of the appropriate sizes and positions
X#
XFUNCTION lj_BarChar(mapstring)
X	DEFINE mapstring CHAR(9)
X        DEFINE x,barsize SMALLINT
X
X        FOR x=1 TO 9
X                IF (mapstring[x,x]=='0') THEN
X                        # thin one */
X                        LET barsize=littlebar
X                ELSE 
X                        # thick one */
X                        LET barsize=bigbar
X                END IF
X                IF x MOD 2 THEN
X                        # black bar - draw it
X                        CALL lj_DoRectangle(atx,barsize,aty ,ysize)
X                ELSE
X                        # gap - do nothing 
X                END IF
X                LET atx = atx + barsize	# move over that much
X        END FOR
X        LET atx = atx + littlebar       # gap between each bar code character
XEND FUNCTION
SHAR_EOF
if [ `wc -c < bc.4gl` -ne     6168 ]
then
    echo "Lengths do not match -- Bad Copy of bc.4gl"
fi
echo "Extracting file pcl.4gl"
sed -e 's/^X//' <<\SHAR_EOF > pcl.4gl
X#
X# Filename: pcl.4gl
X# SCCS    : @(#) pcl.4gl 1.2 96/08/01 16:02:41
X# Desc    : Routines to print effects on PCL printers
X# Version : 1.00
X# Author  : Ti Lian Hwang (tilh@sin-co.sg.dhl.com)
X# Date    : 04 Oct 95
X# 
X# FUNCTION lj_init_pr (prtpipestr,fname,papsize)
X#				- initialises printer
X#				- papsize is 'A4' (dummy at present)
X# FUNCTION lj_term_pr ()	- terminates the PCL system
X# FUNCTION lj_tray (paper_source)
X#				- prints paper from paper_source
X# FUNCTION lj_newpage ()	- prints a newpage
X# FUNCTION lj_moveto (mode,x,y)	- moves Absolute/Relative to (x,y)
X# FUNCTION lj_show_str (str)	- prints str at current position
X# FUNCTION lj_column (x)	- moves to x-pos at the same y-pos
X# FUNCTION lj_newline (x)	- starts a new line at x-pos
X# FUNCTION lj_change_font (font,size)
X#				- changes to a new font of size points
X#                               - if size is 0, retain previous size
X# FUNCTION lj_box (x,y,xsize,ysize,lwidth,shade)
X#                               - draw at (x,y) xsize to right, ysize up
X#				- lwidth points thick
X#				- shade ranges from 0 to 1 (black)
X#
X#				- note that all coordinates are in inches
X#				  measured from bottom left
X#				- unless stated
X#
X# Env Var :
X#
X# Amended :
X# Initials   Amend date   Version    Description of amendment
X#   tilh     04 Oct 95    1.00       initial release
X# 
XDEFINE ytotal SMALLFLOAT	# length of paper
XDEFINE x_inch,y_inch SMALLFLOAT
XDEFINE filename CHAR(64)
XDEFINE line CHAR(256)
XDEFINE fmt CHAR(12)
XDEFINE vmi SMALLFLOAT
XDEFINE pfont,nfont CHAR(32)
XDEFINE psize,nsize CHAR(16)
X
X# barcode variables
XDEFINE x0,y0 SMALLFLOAT		# top-left corner in decipoints
XDEFINE width,height SMALLFLOAT	# barcode size in decipoints
XDEFINE fontsize	 SMALLFLOAT	# size of font in points
XDEFINE xscale	 SMALLFLOAT	# scaling of barcode units to decipoints
X
X{
X# test routine
XMAIN
XDEFINE filename CHAR(64)
XLET filename = ARG_VAL(1)
XCALL init_pr(filename)
XCALL moveto ('A',1,9.5)
XCALL show_str ("I'am at 1,9.5")
XCALL column (4)
XCALL show_str ("I'am at 4,9.5")
XCALL newline (1)
XCALL show_str ("I'am at 1,9.5 one line down")
XCALL newline (2)
XCALL change_font ('BI',20)
XCALL show_str ("I'am at 2,9.5 another line down and italics, size 20")
X
XCALL barcode (1,6.5,"12345",3.0,1.0)
X
XCALL barcode (1,5.5,"ABCDEF",1.0,0.75)
X
XCALL newpage()
XCALL term_pr()
XEND MAIN
X}
XFUNCTION lj_sccs ()
XLET line = "@(#)pcl.4gl	1.2\t08/01/96"
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_init_pr (prtpipestr,fname,papsize)
X######################################################################
XDEFINE prtpipestr,fname CHAR(64), papsize CHAR(5)
X
XLET filename = fname
XLET vmi = 12		# points
X
XLET ytotal = 11.19 * 720		# A4 paper - 0.5 inch of top margin
XLET x_inch = 0
XLET y_inch = 0
XLET fmt = "<<<<<<<.<<<<"
XLET psize = "08V"
XLET nsize = "12H"
XLET nfont =  ASCII(27),"(s0p0s0b4099t"
XLET pfont =  ASCII(27),"(s1p0s0b4101t"
X
XIF LENGTH(prtpipestr) > 0 THEN
X	START REPORT lj_prtline TO PIPE prtpipestr
XELSE
X	START REPORT lj_prtline TO PRINTER
XEND IF
X
XIF LENGTH(filename) = 0 THEN
X	LET line = ASCII(27), "E"
XELSE
X	LET line = ""
XEND IF
X
XLET line = line CLIPPED, nfont CLIPPED,nsize CLIPPED
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_tray (paper_source)
X######################################################################
XDEFINE paper_source CHAR
XLET line = ASCII(27),"&l",paper_source,"H"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_newpage ()
X######################################################################
X
XLET line = ASCII(12)
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_term_pr ()
X######################################################################
XLET line = ASCII(27),"E"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XFINISH REPORT lj_prtline
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_moveto (mode,x,y)
X######################################################################
XDEFINE x,y SMALLFLOAT
XDEFINE mode CHAR
XDEFINE xc,yc CHAR
XDEFINE x_deci, y_deci SMALLINT
X
XCASE mode
XWHEN 'A'
X	LET x_inch = x 
X	LET y_inch = y
X	LET xc = ""
X	LET yc = ""
XWHEN 'R'
X	LET x_inch = x_inch + x
X	LET y_inch = y_inch + y
X	IF x > 0
X		THEN LET xc = "+"
X		ELSE LET xc = "-"
X	END IF
X	IF y > 0
X		THEN LET yc = "+"
X		ELSE LET yc = "-"
X	END IF
XEND CASE
X
XLET x_deci = x_inch * 720
XLET y_deci = ytotal - (y_inch * 720)
X
XLET line = ASCII(27),"&a",
X	xc CLIPPED,x_deci USING fmt,"h",yc CLIPPED,y_deci USING fmt ,"V"
X
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_show_str (str)
X######################################################################
XDEFINE str CHAR(128)
X
XLET line = str CLIPPED
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_newline (x)
X######################################################################
XDEFINE x SMALLFLOAT
XDEFINE x_deci SMALLINT
X
XLET x_deci = x * 720
XLET x_inch = x
XLET y_inch = y_inch + vmi * 10
X
XLET line = ASCII(10),ASCII(27),"&a",x_deci USING fmt,"H"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_column (x)
X######################################################################
XDEFINE x SMALLFLOAT
XDEFINE x_deci SMALLINT
X
XLET x_deci = x * 720
XLET x_inch = x
X
XLET line = ASCII(27),"&a",x_deci USING fmt,"H"
X
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_change_font (font,size)
X######################################################################
XDEFINE font CHAR(3)
XDEFINE size SMALLFLOAT
X
XIF size > 0 THEN 
X	CASE font[1,1]
X		WHEN 'P'  LET psize = size USING fmt,"V"
X		OTHERWISE LET nsize = size USING fmt,"H"
X	END CASE
XEND IF
X
XCASE font
X# constant width fonts
XWHEN 'B'
X	LET line = nfont CLIPPED,nsize CLIPPED,ASCII(27),"(s3B"
XWHEN 'I'
X	LET line = nfont CLIPPED,nsize CLIPPED,ASCII(27),"(s1S"
XWHEN 'BI'
X	LET line = nfont CLIPPED,nsize CLIPPED,ASCII(27),"(s1s3B" 
XWHEN 'IB'
X	LET line = nfont CLIPPED,nsize CLIPPED,ASCII(27),"(s1s3B"
X
X# proportional spacing fonts
XWHEN 'P'
X	LET line = pfont CLIPPED,psize CLIPPED
XWHEN 'PI'
X	LET line = pfont CLIPPED,psize CLIPPED,ASCII(27),"(s1S"
XWHEN 'PB'
X	LET line = pfont CLIPPED,psize CLIPPED,ASCII(27),"(s3B" 
XWHEN 'PBI'
X	LET line = pfont CLIPPED,psize CLIPPED,ASCII(27),"(s1s3B" 
XWHEN 'PIB'
X	LET line = pfont CLIPPED,psize CLIPPED,ASCII(27),"(s1s3B" 
X# default font
XOTHERWISE
X	LET line = nfont CLIPPED,nsize CLIPPED
XEND CASE
X
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_box (x,y,xsize,ysize,lwidth,shade)
X######################################################################
XDEFINE x,y,xsize,ysize,lwidth,shade SMALLFLOAT
XDEFINE x_deci,y_deci,ytop SMALLINT
X
XLET lwidth = lwidth * 10
X
XLET ytop = ytotal - ((y + ysize) * 720)
X# move to top-left
XLET x_deci = x * 720
XLET y_deci = ytop
XLET line = 
X	ASCII(27),"&a",x_deci USING fmt,"h",y_deci USING fmt,"V"
X
X# draw top-left to top-right
XLET x_deci = xsize * 720
XLET y_deci = lwidth
XLET line = line CLIPPED,
X	ASCII(27),"*c",x_deci USING fmt,"h",y_deci USING fmt,"v0P"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
X# move to top-right
XLET x_deci = (x + xsize) * 720 - lwidth
XLET y_deci = ytop
XLET line = 
X	ASCII(27),"&a",x_deci USING fmt,"h",y_deci USING fmt,"V"
X
X# draw top-right to bottom-right
XLET x_deci = lwidth
XLET y_deci = ysize * 720
XLET line = line CLIPPED,
X	ASCII(27),"*c",x_deci USING fmt,"h",y_deci USING fmt,"v0P"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
X# move to top-left
XLET x_deci = x * 720
XLET y_deci = ytop
XLET line = 
X	ASCII(27),"&a",x_deci USING fmt,"h",y_deci USING fmt,"V"
X
X#draw top-left to bottom-left
XLET x_deci = lwidth
XLET y_deci = ysize * 720
XLET line = line CLIPPED,
X	ASCII(27),"*c",x_deci USING fmt,"h",y_deci USING fmt,"v0P"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
X# move to bottom-left
XLET x_deci = x * 720
XLET y_deci = ytop + (ysize * 720) - lwidth
XLET line = 
X	ASCII(27),"&a",x_deci USING fmt,"h",y_deci USING fmt,"V"
X
X#draw bottom-left to bottom-right
XLET x_deci = xsize * 720
XLET y_deci = lwidth
XLET line = line CLIPPED,
X	ASCII(27),"*c",x_deci USING fmt,"h",y_deci USING fmt,"v0P"
X
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
XIF shade > 0 THEN
X	LET x_deci = x * 720
X	LET y_deci = ytop
X	LET line = 
X		ASCII(27),"&a",x_deci USING fmt,"h",y_deci USING fmt,"V"
X	LET x_deci = xsize * 720
X	LET y_deci = ysize * 720
X	LET shade = shade * 100
X	LET line = line CLIPPED, ASCII(27),"*c",shade USING fmt,"g",
X		x_deci USING fmt,"h",y_deci USING fmt,"v2P"
X	OUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND IF
X
XEND FUNCTION
X
X######################################################################
XREPORT lj_prtline (str)
X######################################################################
XDEFINE str CHAR(128)
XDEFINE cnt SMALLINT
XOUTPUT
X	TOP MARGIN 0
X	BOTTOM MARGIN 0
X	LEFT MARGIN 0
X	PAGE LENGTH 5
XFORMAT
XFIRST PAGE HEADER
X	LET cnt = 1
XON EVERY ROW
XIF cnt = 1 AND LENGTH(filename) > 0 THEN
X	PRINT FILE filename
XEND IF
X	PRINT str CLIPPED;
X	LET cnt = cnt + 1
XEND REPORT
X
X# barcode functions
X
X######################################################################
XFUNCTION lj_InitBar (xpos,ypos,x,y,font_size,barscale)
X######################################################################
XDEFINE xpos,ypos SMALLFLOAT	# in inches, 0,0 is bottom-left
XDEFINE x,y SMALLFLOAT		# in inches, size of bar
XDEFINE font_size SMALLFLOAT	# in points
XDEFINE barscale SMALLFLOAT	# scaling of barcode units to points 
X
XLET width = x * 720
XLET height = y * 720
XLET x0 = xpos * 720
XLET y0 = ytotal - (ypos * 720) - height
XLET fontsize = font_size
XLET xscale = barscale * 10
X
X# attempt 300 dpi if no 600 dpi
XLET line = ASCII(27),"*t300R", ASCII(27),"*t600R"
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
XEND FUNCTION
X
X#
X# low-level hp commands to fill rectangles
X#
X######################################################################
XFUNCTION lj_DoRectangle(atx,xsize,aty,ysize)
X######################################################################
XDEFINE atx,xsize,aty,ysize SMALLINT
XDEFINE xabs,yabs SMALLFLOAT
X
XLET xabs = x0 + (atx * xscale)
XLET yabs = y0
XLET line = ASCII(27),"&a", xabs USING fmt, "h", yabs USING fmt, "V" # position
X
XLET xabs = xsize * xscale
XLET yabs = height 
XLET line = line CLIPPED,  
X	ASCII(27),"*c", xabs USING fmt, "h", yabs USING fmt, "V"	# size
XLET line = line CLIPPED,  ASCII(27),"*c0P"				# fill
X
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
XEND FUNCTION
X
X######################################################################
XFUNCTION lj_TermBar()
X######################################################################
XEND FUNCTION
X
XFUNCTION lj_PrintChar(x,c)
XDEFINE x SMALLINT		# in barcode units
XDEFINE c CHAR
X
XDEFINE xabs,yabs SMALLFLOAT
X
XLET xabs = x0 + x * xscale
XLET yabs = y0 + height + (fontsize * 12)
X
XLET line = ASCII(27),"&a",xabs USING fmt,"h",yabs USING fmt ,"V",c
XOUTPUT TO REPORT lj_prtline (line CLIPPED)
X
XEND FUNCTION
SHAR_EOF
if [ `wc -c < pcl.4gl` -ne    11374 ]
then
    echo "Lengths do not match -- Bad Copy of pcl.4gl"
fi
echo "Extracting file ps.4gl"
sed -e 's/^X//' <<\SHAR_EOF > ps.4gl
X#
X# Filename: ps.4gl
X# SCCS    : @(#) ps.4gl 1.1 96/04/18 15:04:58 (C)
X# Desc    : Routines to print effects on postscript printers
X# Version : 1.00
X# Author  : Ti Lian Hwang (tilh@sin-co.sg.dhl.com)
X# Date    : 04 Oct 95
X# 
X# FUNCTION lj_init_pr (prtpipestr,fname,papsize)	
X#				- initialise the postscript system
X#				  prtpipestr is the command to PIPE to
X#                                 fname is the name of a header file
X# FUNCTION lj_term_pr ()	- terminates the postscript system
X# FUNCTION lj_tray (paper_source)	- selects paper tray (dummy )
X# FUNCTION lj_newpage ()	- prints a newpage
X# FUNCTION lj_moveto (mode,x,y)	- moves Absolete/Relative to (x,y)
X# FUNCTION lj_show_str (str)	- prints str at current position
X# FUNCTION lj_column (x)	- moves to x-pos at the same y-pos
X# FUNCTION lj_newline (x)	- starts a new line at x-pos
X# FUNCTION lj_change_font (font,size) 
X#				- changes to a new font of size points
X#                               - if size is 0, retain previous size
X# FUNCTION lj_box (x,y,xsize,ysize,lwidth,shade)
X#                               - draw at (x,y) xsize to right, ysize up
X#				- lwidth points thick
X#				- shade ranges from 0 to 1 (black)
X#
X#				- note that all coordinates are in inches
X#				- unless stated
X#
X# Env Var :
X#
X# Amended :
X# Initials   Amend date   Version    Description of amendment
X#   tilh     04 Oct 95    1.00       initial release
X# 
XDEFINE x_inch,y_inch SMALLFLOAT
XDEFINE filename CHAR(64)
XDEFINE line CHAR(512)
XDEFINE fmt CHAR(12)
X
X{
X# test routine
XMAIN
XDEFINE filename CHAR(64)
XLET filename = ARG_VAL(1)
XCALL init_pr(filename)
XCALL moveto ('A',1,9.5)
XCALL show_str ("I'am at 1,9.5")
XCALL column (4)
XCALL show_str ("I'am at 4,9.5")
XCALL newline (1)
XCALL show_str ("I'am at 1,9.5 one line down")
XCALL newline (2)
XCALL change_font ('BI',20)
XCALL show_str ("I'am at 2,9.5 another line down and italics, size 20")
X
XCALL barcode (1,6.5,"12345",3.0,1.0)
X
XCALL barcode (1,5.5,"ABCDEF",1.0,0.75)
X
XCALL newpage()
XCALL term_pr()
XEND MAIN
X}
XFUNCTION lj_sccs ()
XLET line = "@(#)ps.4gl	1.1\t04/18/96"
XEND FUNCTION
X
XFUNCTION lj_init_pr (prtpipestr,fname,papsize)
XDEFINE prtpipestr,fname CHAR(64), papsize CHAR(5)
X
XLET filename = fname
X
XLET x_inch = 0
XLET y_inch = 720
XLET fmt = "-<<<<<<.<<<<"
XIF LENGTH(prtpipestr) > 0 THEN                  
X        START REPORT lj_prtline TO PIPE prtpipestr
XELSE                                            
X        START REPORT lj_prtline TO PRINTER        
XEND IF                                          
X
X
XEND FUNCTION
X
XFUNCTION lj_tray (papersource)
XDEFINE papersource CHAR
X{
X# this may be HP laserjet specific - still needs to remap depending on model !
XOUTPUT TO REPORT lj_prtline ("statusdict begin")
XLET line = papersource USING "<<", " setpapertray"
XOUTPUT TO REPORT lj_prtline (line)
XOUTPUT TO REPORT lj_prtline ("end")
X}
XEND FUNCTION
X
XFUNCTION lj_newpage ()
XOUTPUT TO REPORT lj_prtline ("showpage")
XEND FUNCTION
X
XFUNCTION lj_term_pr ()
XFINISH REPORT lj_prtline
XEND FUNCTION
X
XFUNCTION lj_moveto (mode,x,y)
XDEFINE x,y SMALLFLOAT
XDEFINE mode CHAR
X
XCASE mode
XWHEN 'A'
X	LET x_inch = x
X	LET y_inch = y
XWHEN 'R'
X	LET x_inch = x_inch + x
X	LET y_inch = y_inch + y
XEND CASE
X
XLET line = x_inch USING fmt," inch ",y_inch USING fmt," inch moveto"
XOUTPUT TO REPORT lj_prtline (line)
XLET line = "/vpos ",y_inch USING fmt," inch def"
XOUTPUT TO REPORT lj_prtline (line)
XLET line = "/hpos ",x_inch USING fmt," inch def"
XOUTPUT TO REPORT lj_prtline (line)
XEND FUNCTION
X
XFUNCTION lj_show_str (str)
XDEFINE x,y SMALLFLOAT
XDEFINE str CHAR(128)
XDEFINE i,j SMALLINT
X
XLET line = "("
XLET j = 2
XFOR i = 1 TO LENGTH(str CLIPPED)
X	IF str[i,i] = ")" OR str[i,i] = "(" THEN
X		LET line[j,j] = "\\"
X		LET j = j + 1
X	END IF
X	LET line[j,j] = str[i,i]
X	LET j = j + 1
XEND FOR
XLET line = line CLIPPED, ") show"
XOUTPUT TO REPORT lj_prtline (line)
X
XEND FUNCTION
X
XFUNCTION lj_newline (x)
XDEFINE x SMALLFLOAT
X
XLET line = "/hpos ",x USING fmt," inch def"
XOUTPUT TO REPORT lj_prtline (line)
XOUTPUT TO REPORT lj_prtline ("newline")
XEND FUNCTION
X
XFUNCTION lj_column (x)
XDEFINE x SMALLFLOAT
X
XLET line = x USING fmt," inch column"
XOUTPUT TO REPORT lj_prtline (line)
XEND FUNCTION
X
XFUNCTION lj_change_font (font,size)
XDEFINE font CHAR(3)
XDEFINE size SMALLFLOAT
X
XIF size <> 0 THEN 
X	LET line = size USING fmt
X	IF font[1,1] = "P" THEN
X		LET line = line CLIPPED," pn_scale scalefont setfont"
X	ELSE 
X		LET line = line CLIPPED," fn_scale scalefont setfont"
X	END IF
XELSE
X	LET line = " setfont"
XEND IF
XCASE font
X
X# constant width fonts
XWHEN 'B'
X	LET line = "Bfont ",line CLIPPED
XWHEN 'I'
X	LET line = "Ifont ",line CLIPPED
XWHEN 'BI'
X	LET line = "BIfont ",line CLIPPED
XWHEN 'IB'
X	LET line = "BIfont ",line CLIPPED
X
X# proportional spacing fonts
XWHEN 'P'
X	LET line = "PNfont ",line CLIPPED
XWHEN 'PI'
X	LET line = "PIfont ",line CLIPPED
XWHEN 'PB'
X	LET line = "PBfont ",line CLIPPED
XWHEN 'PBI'
X	LET line = "PBIfont ",line CLIPPED
XWHEN 'PIB'
X	LET line = "PBIfont ",line CLIPPED
XOTHERWISE
X	LET line = "Nfont ",line CLIPPED
XEND CASE
X
XOUTPUT TO REPORT lj_prtline (line)
XEND FUNCTION
X
XFUNCTION lj_box (x,y,xsize,ysize,lwidth,shade)
XDEFINE x,y,xsize,ysize,lwidth,shade SMALLFLOAT
XDEFINE l CHAR(512)
X
XLET line = x USING fmt, " inch ", y using fmt , " inch moveto ",
X	xsize USING fmt, " inch 0 rlineto ",
X	"0 ",ysize USING fmt, " inch rlineto ",
X	-xsize USING fmt, " inch 0 rlineto"
XOUTPUT TO REPORT lj_prtline (line)
X
XIF shade >= 0 THEN
X	LET shade = 1 - (shade * 0.5)
X	LET l = shade USING fmt, " setgray fill 0 setgray"
X	OUTPUT TO REPORT lj_prtline (l)
X	OUTPUT TO REPORT lj_prtline (line)
XEND IF
X
XLET line =  "closepath ",lwidth USING fmt," setlinewidth stroke"
XOUTPUT TO REPORT lj_prtline (line)
X
XEND FUNCTION
X
XREPORT lj_prtline (str)
XDEFINE str CHAR(128)
XDEFINE cnt SMALLINT
XOUTPUT
X	TOP MARGIN 0
X	BOTTOM MARGIN 0
X	LEFT MARGIN 0
X	PAGE LENGTH 5
XFORMAT
XFIRST PAGE HEADER 
XLET cnt = 1
X
XON EVERY ROW
X
XIF cnt = 1 AND LENGTH(filename) > 0 THEN
X	PRINT FILE filename
X	LET cnt = cnt + 1
XEND IF
XPRINT str CLIPPED
XEND REPORT
X#
X# low-level postscript commands to for barcode
X#
XFUNCTION lj_DoRectangle(atx,xsize,aty,ysize)
X	DEFINE atx,xsize,aty,ysize SMALLINT
X
X	LET line = atx USING fmt, aty USING fmt, " moveto"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	LET line = xsize USING fmt, " 0 rlineto"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	LET line = "0 ", ysize USING fmt, " rlineto"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	LET line = -xsize USING fmt, " 0 rlineto"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	OUTPUT TO REPORT lj_prtline ("closepath fill")
XEND FUNCTION
X
XFUNCTION lj_InitBar (xpos,ypos,x,y,font_size,barscale)
XDEFINE xpos,ypos,x,y SMALLFLOAT	# in inches
XDEFINE font_size SMALLFLOAT	# in points
XDEFINE barscale SMALLFLOAT	# scaling of barwidth
X
X	OUTPUT TO REPORT lj_prtline ("gsave")
X	LET line = xpos USING fmt," inch ", ypos USING fmt," inch translate"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	OUTPUT TO REPORT lj_prtline ("/Helvetica findfont");               
X	LET line = "[",font_size/barscale USING fmt, " 0 0 ",
X		font_size USING fmt, " 0 0 ] makefont setfont"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	LET line = barscale USING fmt, " 1 scale"
X	OUTPUT TO REPORT lj_prtline (line)
X
X	OUTPUT TO REPORT lj_prtline ("newpath")
XEND FUNCTION
X
XFUNCTION lj_TermBar()
X
X	OUTPUT TO REPORT lj_prtline ("grestore")
X
XEND FUNCTION
X
XFUNCTION lj_PrintChar(x,c)
XDEFINE x SMALLINT
XDEFINE c CHAR
X
X	LET line = x, " 0 moveto"
X	OUTPUT TO REPORT lj_prtline (line)
X	LET line = "(",c, ") show"
X	OUTPUT TO REPORT lj_prtline (line)
XEND FUNCTION
SHAR_EOF
if [ `wc -c < ps.4gl` -ne     7427 ]
then
    echo "Lengths do not match -- Bad Copy of ps.4gl"
fi
echo "Done."
exit 0