/* This routine reads the main header record of a ELAS data file. All        */
/* variables are exposed to the calling program.                             */
/*                                                                           */
/* Required input variables:                                                 */
/*   fully qualified name of file (passed as a calling argument)             */
/*                                                                           */
/* Doug Rickman  10/13/96                                                    */
/* mod. June 21, 1997                                                        */
/* mod. for ELAS  Oct 25, 1997                                               */
/* mod. for Comments and Color Table Nov 9, 1997                             */
/* mod. June 19, 1998                                                        */
/* mod. April 22, 2000 to hide internal variables (at last!)                 */
/* mod. April 24, 2000 to close file when not an ELAS file.  How stupid!!!   */
/* mod. April 25, 2000 to use GenericError()  Added check for file size.     */
/*      _______________________________________________________________      */

procedure expose Header BperLine,
                 InitialLine LastLine NLines,
                 InitialElement LastElement NElements,
                 NChannels,
                 YCD XCD XOF YOF Ht Wid,
                 Tran1 Tran2 Tran3 Tran4,
                 DataTypeCode NBperElement,
                 Eikonix LABLStatus CreatedBy,
                 comments,
                 Blue. Red. Green.,
                 GenericErrorQUIET SubRoutineHistory

SubRoutineHistory = 'ReadELASMain' SubRoutineHistory

signal on syntax name GenericError

input=arg(1)

rc=stream(input,'c','open read')
if rc<>'READY:' then do
   parse var SubRoutineHistory . SubRoutineHistory
   return 'File could not be made ready.'
   end

/* write out the header */
/* Bytes in header  - Bytes per line - Initial Line    - LastLine            */
/* Initial Element  - Last Element   - No. of Channels - ELAS ID flag        */
/* YCD              - YOF            - XCD             - XOF                 */
/* Ht               - Wid            - Tran1           - Tran2               */
/* Tran3            - Tran4          - Word 19         - blank               */
/* blank            - Eikonix flag   - Labl status     - Created by module   */
/* words 25-120 - comments                                          */
/*                                                                           */

/* Read header data from ELAS file                                           */
Header=c2x(charin(input,,4))
if Header='00000400' then nop
else do
   rc=stream(input,'c','close')
   parse var SubRoutineHistory . SubRoutineHistory
   Return 'is not an ELAS file.'
   end
Header=x2d(Header)

BperLine=x2d(c2x(charin(input,,4)))

InitialLine=x2d(c2x(charin(input,,4)))
LastLine=x2d(c2x(charin(input,,4)))
Nlines=LastLine-InitialLine+1

InitialElement=x2d(c2x(charin(input,,4)))
LastElement=x2d(c2x(charin(input,,4)))
Nelements=LastElement-InitialElement+1

NChannels=x2d(c2x(charin(input,,4)))

/* Check for problem with file size. */               
ComputedFileSize=1024+NLines*BperLine*NChannels
if ComputedFileSize \= dosfsize(input) then do
   rc=stream(input,'c','close')
   parse var SubRoutineHistory . SubRoutineHistory
   Return 'Problem with header vs. file size.'
   end


ELASflag=charin(input,,4)
YCD=charin(input,,4)
YOF=x2d(c2x(charin(input,,4)),8)
XCD=charin(input,,4)
XOF=x2d(c2x(charin(input,,4)),8)
HT=c2f(reverse(charin(input,,4)))
WID=c2f(reverse(charin(input,,4)))

tran1=c2f(reverse(charin(input,,4)))
tran2=c2f(reverse(charin(input,,4)))
tran3=c2f(reverse(charin(input,,4)))
tran4=c2f(reverse(charin(input,,4)))

/* word 19 */
Sentinal=x2d(c2x(charin(input,,2)))
Word19_16_31=x2b(c2x(charin(input,,2)))
ChannelHeaderFlag=left(Word19_16_31,1)
DataTypeCode=substr(Word19_16_31,2,5)
NBperElement=substr(Word19_16_31,9)

DataTypeCode = x2d(b2x(DataTypeCode))
NBperElement = x2d(b2x(NBperElement))

select
	when DataTypeCode=0  then do
		DataType='MIXED OR UNSPECIFIED DATA TYPE'
		PCIDataType='?'
		end
	when DataTypeCode=1  then do
		DataType='UNSIGNED INTEGER'
		PCIDataType='U'
		end
	when DataTypeCode=16 then do
		DataType='SINGLE PRECISION REAL'
		PCIDataType='R'
		end
	when DataTypeCode=17 then do
		DataType='DOUBLE PRECISION REAL'
		PCIDataType='R'
		end
	when DataTypeCode=18 then do
		DataType='SINGLE PRECISION COMPLEX'
		PCIDataType='Complex'
		end
	when DataTypeCode=19 then do
		DataType='DOUBLE PRECISION COMPLEX'
		PCIDataType='Complex'
		end
	when DataTypeCode=31 then do
		DataType='ASCII CHARACTERS'
		PCIDataType='ASCII'
		end
	otherwise say 'SOMETHING IS WRONG WITH THE DATA TYPE CODE!!!'
	end

/* Words 20-24 */
Undefined1=charin(input,,4)
Undefined2=charin(input,,4)
Eikonix=charin(input,,4)
LABLStatus=charin(input,,4)

CreatedBy=charin(input,,4)

/*  6 lines of comments,  Words 25 - 120 */
comments=''
do i = 1 to 6 
	Comment.i=charin(input,,64)
	comments=comments||comment.i
	end i

/* 256 color table entries, Words 121 - 248  */
do i = 0 to 255
	data=c2x(charin(input,,2))
	Blue.i=x2d(substr(data,2,1))
	Red.i=x2d(substr(data,3,1))
	Green.i=x2d(substr(data,4,1))
	end i

/* undefined block, words 249- 256 */
Undefined3=charin(input,,4)
Undefined4=charin(input,,4)
Undefined5=charin(input,,4)
Undefined6=charin(input,,4)
Undefined7=charin(input,,4)
Undefined8=charin(input,,4)
Undefined9=charin(input,,4)
Undefined10=charin(input,,4)

rc=lineout(input)

signal off syntax

parse var SubRoutineHistory . SubRoutineHistory

return 1