IDENTIFICATION DIVISION.

PROGRAM-ID.	Concatenate_sixel.
AUTHOR.		Ken Richardson.
INSTALLATION.	Compassion, Int'l.
DATE-WRITTEN.	June 10, 1988.
DATE-COMPILED.

*	Written to the glory of God.

ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SPECIAL-NAMES.
	symbolic	ascii-27	28
	.

SOURCE-COMPUTER.	VAX-11.
OBJECT-COMPUTER.	VAX-11.

INPUT-OUTPUT SECTION.
FILE-CONTROL.

	select 	input-file-a
		assign to "ci$input:"
	.

	select 	input-file-b
		assign to "ci$input_2:"
	.

	select 	output-file
		assign to "ci$output:"
	.

DATA DIVISION.

FILE SECTION.

fd	input-file-a
	record is varying depending on input-file-a-record-size
	.

01	input-file-a-record		pic x(1024).

fd	input-file-b
	record is varying depending on input-file-b-record-size
	.

01	input-file-b-record		pic x(1024).

fd	output-file
	record is varying depending on output-file-record-size
	.

01	output-file-record			pic x(1024).		


WORKING-STORAGE SECTION.

01  constants.
    02  ascii-27-char				pic x value ascii-27.
    02  ignore-blanks-and-tabs			pic s9(9) comp value 17.
    02  logical-line-delimiter			pic x value "-".
    02  longword-size-in-bytes			pic s9(9) comp value 4.
    02  spacing-record-length			pic s9(9) comp value 8.
    02  ws-false				pic x value "F".
    02  ws-true					pic x value "T".

01  variables.
    02  characters-spanned			pic s9(9) comp.
    02  ci$sixel_offset				pic x(10).
    02  dispatch-1				pic s9(9) comp.
    02  display-count				pic zzz,zzz,zz9.
    02  input-file-a-record-count		pic s9(9) comp value zero.
    02  input-file-a-record-size		pic 9(9) comp.
    02  input-file-b-record-count		pic s9(9) comp value zero.
    02  input-file-b-record-size		pic 9(9) comp.
    02  char-sub				pic s9(9) comp.
    02  next-a-char				pic s9(9) comp.
    02  next-b-char				pic s9(9) comp.
    02  output-file-record-count		pic s9(9) comp value zero.
    02  output-file-record-size			pic 9(9) comp.
    02  return-status				pic s9(9) comp.
    02  sixel-offset-longword			pic 9(9) comp.
    02  spacing-record.
	03  filler				pic x(2) value "$!".
	03  numeric_sixel_offset		pic 9(5).
	03  filler				pic x value "?".

01  switches.
    02  abort-sw				pic x.
    02  end-of-input-file-a-sw			pic x.
    02  end-of-input-file-b-sw			pic x.
    02  escape-allowed-in-a-sw			pic x.
    02  escape-skipped-in-b-sw			pic x.
    02  logical-line-delimiter-found-sw		pic x.


PROCEDURE DIVISION.

Concatenate-a-and-b.
	move	ws-false to abort-sw
	perform varying dispatch-1 from 1 by 1
		until	dispatch-1 > 4
			or
			abort-sw = ws-true
		evaluate dispatch-1
			when	1
				call	"sys$trnlog"
					using	by descriptor	"CI$SIXEL_OFFSET"
						omitted
						by descriptor	ci$sixel-offset
						omitted
						omitted
						omitted
					giving	return-status
				if	return-status is not success
				then
					display "Logical name CI$SIXEL_OFFSET should be defined."
					move	ws-true to abort-sw
				end-if
			when	2
				call	"ots$cvt_ti_l"
					using	by descriptor	ci$sixel-offset
						by reference	sixel-offset-longword
						by value	longword-size-in-bytes
						by value	ignore-blanks-and-tabs
					giving	return-status
				if	return-status is not success
				then
					display "Logical name CI$SIXEL_OFFSET should be numeric."
					move	ws-true to abort-sw
				end-if
			when	3
				if	sixel-offset-longword < 65536
				then
					move	sixel-offset-longword to numeric-sixel-offset
				else
					display "Logical name CI$SIXEL_OFFSET should be a number between 0 and 65535."
					move	ws-true to abort-sw
				end-if
			when	4
				perform process-files
			when	other
				display "Dispatch error in dispatch-1."
				move	ws-true to abort-sw
		end-evaluate
	end-perform

	if	abort-sw = ws-true
	then
		display "Program aborting."
	end-if

	stop	run
	.


process-files.
	move	ws-false to escape-allowed-in-a-sw
	move	ws-false to escape-skipped-in-b-sw

	open	input	input-file-a
			input-file-b
		output	output-file

	move	ws-false to end-of-input-file-a-sw
	perform c-read-record-a
	move	ws-false to end-of-input-file-b-sw
	perform c-read-record-b

	perform create-logical-output-line
		until	(	end-of-input-file-a-sw = ws-true
				and
				end-of-input-file-b-sw = ws-true
			)
			or
			abort-sw = ws-true

	move	input-file-a-record-count to display-count
	display display-count
		" A records read."

	move	input-file-b-record-count to display-count
	display display-count
		" B records read."

	move	output-file-record-count to display-count
	display display-count
		" records written."

	close	input-file-a
		input-file-b
		output-file
	.


create-logical-output-line.
	perform copy-logical-line-a
	perform copy-logical-line-b
	.


copy-logical-line-a.
*	copy the sixel data
	move	ws-false to logical-line-delimiter-found-sw
	perform copy-physical-line-a-fragment
		until	logical-line-delimiter-found-sw = ws-true
			or
			end-of-input-file-a-sw = ws-true
	.


copy-physical-line-a-fragment.
*	Allow only the first "escape" line in file A
	if	escape-allowed-in-a-sw = ws-true
		and
		input-file-a-record ( 1 : 1 ) = ascii-27-char
	then
*		"escape" line; get another line
		perform c-read-record-a
	else
		if	input-file-a-record ( 1 : 1 ) = ascii-27-char
		then
			move	ws-true to escape-allowed-in-a-sw
		end-if

		perform varying char-sub from next-a-char by 1
			until	char-sub > input-file-a-record-size
				or
				input-file-a-record ( char-sub : 1 ) = logical-line-delimiter
			continue
		end-perform
		compute characters-spanned = char-sub - next-a-char

*		any useful characters to write?
		if	characters-spanned > zero
		then
*			write the line fragment
			move	input-file-a-record ( next-a-char : characters-spanned ) to output-file-record ( 1 : characters-spanned )
			move	characters-spanned to output-file-record-size
			perform c-write-record
		end-if

*		where are we on the line?
		if	char-sub > input-file-a-record-size
		then
*			get another line
			perform c-read-record-a
		else
*			skip the logical-line-delimiter
			compute next-a-char = char-sub + 1
			move	ws-true to logical-line-delimiter-found-sw
		end-if
	end-if
	.


copy-logical-line-b.
	if	end-of-input-file-b-sw = ws-false
	then
*		insert spacing
		move	spacing-record to output-file-record ( 1 : spacing-record-length )
		move	spacing-record-length to output-file-record-size
		perform c-write-record
*		copy the sixel data
		move	ws-false to logical-line-delimiter-found-sw
		perform copy-physical-line-b-fragment
			until	logical-line-delimiter-found-sw = ws-true
				or
				end-of-input-file-b-sw = ws-true
	else
		move	logical-line-delimiter to output-file-record ( 1 : 1 )
		move	1 to output-file-record-size
		perform c-write-record
	end-if
	.


copy-physical-line-b-fragment.
*	skip first "escape" line in file B
	if	escape-skipped-in-b-sw = ws-false
		and
		input-file-b-record ( 1 : 1 ) = ascii-27-char
	then
		move	ws-true to escape-skipped-in-b-sw
*		get another line
		perform c-read-record-b
	else
		perform varying char-sub from next-b-char by 1
			until	char-sub > input-file-b-record-size
				or
				input-file-b-record ( char-sub : 1 ) = logical-line-delimiter
			continue
		end-perform

*		are we on a delimiter?
		if	char-sub not > input-file-b-record-size
		then
*			yes, include it
			add	1 to char-sub
			move	ws-true to logical-line-delimiter-found-sw
		end-if
		compute characters-spanned = char-sub - next-b-char

*		any useful characters to write?
		if	characters-spanned > zero
		then
*			write the line fragment
			move	input-file-b-record ( next-b-char : characters-spanned ) to output-file-record ( 1 : characters-spanned )
			move	characters-spanned to output-file-record-size
			perform c-write-record
		end-if

*		where are we on the line?
		if	char-sub > input-file-b-record-size
		then
*			get another line
			perform c-read-record-b
		else
*			skip the logical-line-delimiter
			compute next-b-char = char-sub
		end-if
	end-if
	.


c-read-record-a.
	add	1 to input-file-a-record-count
	read	input-file-a
		at end
		move	ws-true to end-of-input-file-a-sw
		subtract 1 from input-file-a-record-count
	end-read
	move	1 to next-a-char
	.


c-read-record-b.
	add	1 to input-file-b-record-count
	read	input-file-b
		at end
		move	ws-true to end-of-input-file-b-sw
		subtract 1 from input-file-b-record-count
	end-read
	move	1 to next-b-char
	.


c-write-record.
	add	1 to output-file-record-count
	write	output-file-record
	.