; didatest.pro: Ein Testprogramm fuer die Vorlesung.
;+
; NAME:           didatest
; PURPOSE:
;    Read structure of a file written in DIDA format
;    Such files (.lpf, .vpf, .cpf) are generated
;    at HASYLAB at the beamline A2 and by the program
;    MICKI written by Rainer Steube.
;    Citing R. Steube: "DIDA is a set of routines and
;    functions for storing and retrieving data ... The
;    general structure has been taken from the Australian
;    DDF-package which originally has been written in
;    RATFOR (by PTR et al.)."
; CATEGORY:
;    Input/Output
; CALLING SEQUENCE:
;    result = didatest('filename')
;    In the future this program shall be used in several
;    variants in order to accomplish access of curves
;    or images, which are stored in a different manner
; SIDE EFFECTS:
;    A file is read.
; AUTHOR:
;    Norbert Stribeck
;    stribeck@vxdesy.desy.de
; MODIFICATION HISTORY:
; 1997 Oct 29 Begin of the test version from the pv-wave course
;-

FUNCTION _OPEN_SESAME, file
;        ============
; This is an internal function, which extracts the sesame
; information from the file in order to find out about the
; blocking of the dida-file.
; File opening and closing is done internally. This function
; is intended for a quick glance at the file structure.

  ; The structure to be returned.
  INFO={INFOTYP, $
          NeedSwap:0,  $
          Clusters:0L, $
          HiObjNr: 0L, $
          LastCatP:0L, $
          CLUSSIZE:0L }

  ;***Open the file***
  GET_LUN, lun
  ON_IOERROR, close_with_ioerr
  ON_ERROR_GOTO, close_and_return1
  OPENR, lun, file

  ; read the sesame block
  ON_IOERROR, close_and_return1

  IBLOCK = lonarr(16) ; File structure in 16 LongInts
  READU, lun, IBLOCK
  ; The meaning of IBLOCK:
  ; (0) LUN once used for file access by FORTRAN bookkeeper
  ; (1) File access mode (-1: Read access | 1: Write access)
  ; (2) Number of occupied clusters
  ; (3) Highest object number in file
  ; (4) File status (0: Old | 1: New)
  ; (5) Last written CatPage
  ; (6) Last read CatPage
  ; (7) Close Flag (1=was closed correctly; 0=was not closed)
  ; (8) Size of a single Cluster (page) in bytes.
  ; (9) ... : CatPage of a degenerate file, if IBLOCK(1) EQ 0.

  ; Are we both of the same Endians?
  Info.NeedSwap = IBLOCK(7) EQ '01000000'xL
  ; Invert byte order of all long integers!
  IF Info.NeedSwap THEN BYTEORDER, IBLOCK, /LSWAP

  ; Is this a DiDa file?
  IF (IBLOCK(1) NE 1) OR (IBLOCK(4) NE 1) OR (IBLOCK(7) NE 1) THEN BEGIN
    PRINT, '_OPEN_SESAME: This file does not look like a common DIDA file:'
    PRINT, 'Unusual access mode OR bad file status OR file not closed'
    PRINT, IBLOCK
    GOTO, close_and_return1
  ENDIF

  Info.Clusters = IBLOCK(2)
  Info.HiObjNr  = IBLOCK(3)
  Info.LastCatP = IBLOCK(5)
  Info.ClusSize = IBLOCK(8)
  GOTO, close_and_return1

close_with_ioerr:
  PRINT, !Err,': ',!Err_String
close_and_return1:
  CLOSE, lun
  FREE_LUN, lun

  RETURN, info
END ; End Function _OPEN_SESAME

PRO _DIDADOC, FILE, INFO
;   ========
; Prints the contents of the Sesame-block of a DIDA file

  ON_ERROR, 2
  PRINT, 'File: ' ,file, ' may contain up to ', STRTRIM(info.HiObjNr,2), $
         ' object(s)'
  PRINT, 'in ', STRTRIM(info.Clusters,2), ' pages. Page size:', $
          STRTRIM(info.ClusSize,2),' Bytes'
  IF info.needswap THEN $
    PRINT, 'Endian switch active: Bytes must be swapped'
  RETURN
END ; Procedure _DIDADOC

FUNCTION _GET_ABSOLUTE, DIDA, CluNr
;        =============
; Basic block reading from an open DIDA file. Works only on
; an open DIDA file. Internal bookkeeping is done
; via the structure DIDA. CluNr is the number of the cluster,
; which shall be read. Cluster numbering starts with 0. 

  ON_ERROR, 2
  ON_IOERROR, exit1

  ; generate an empty result  
  block = BYTARR( DIDA.ClusSize )

  IF NOT DIDA.open THEN BEGIN
    MESSAGE, 'DIDA file not open', /Continue
    DIDA.ERROR = 1
    RETURN, block
  ENDIF

  ; Position the file pointer
  POINT_LUN, DIDA.lun, DIDA.ClusSize*CluNr
  ; read the cluster content to block
  READU, DIDA.lun, block
  DIDA.ERROR = 0

  GOTO, normal_exit  
exit1:
  DIDA.ERROR = 1
normal_exit:
  RETURN, block
END ; Function _GET_ABSOLUTE

PRO _REWIND, DIDA
;   =======
; Catalogue pages are stored sequentially in a predefined
; pattern. So there should be a procedure to "rewind"
; the catalogue and to "read the next catalogue page".
; This procedure does only bookkeeping in the file control block.

  DIDA.CatPos = -1
  RETURN
END ; Procedure _REWIND

FUNCTION _NEXT_CATPAGE, DIDA
;        =============
; Every DIDA file has a predefined sequential structure:
; The first block is the "sesame", which explains the blocking.
; The second block is the first catalogue page with DIDA.CatSize
; entries describing those data blocks, which follow the
; catalogue page. Then comes the next catalogue page, and so on.
;   The next access after reading the last CatPage will result
; in an empty CatPage and the file rewound (DIDA.CatPos=-1).

 DIDA.CatPos LT 0 THEN BEGIN
    ; Set to first catalogue page (i. e. "rewind")
    DIDA.CatPos = 1
    catalog = _GET_ABSOLUTE( DIDA, DIDA.CatPos )
  ENDIF ELSE BEGIN
    DIDA.CatPos = DIDA.CatPos + DIDA.CatSize + 1
    IF (DIDA.CatPos GT DIDA.LastCatP) $
      THEN BEGIN
             _REWIND, DIDA
             catalog = BYTARR( DIDA. ClusSize )
           ENDIF $
      ELSE catalog = _GET_ABSOLUTE( DIDA, DIDA.CatPos )
  ENDELSE

  ; Regardles of success or failure we have read an array
  ; of bytes, while the catalogue is made from long integers.
  ; Type Cast:
  catalog = LONG( catalog, 0, 4*DIDA.CatSize )

  ; If we have read "from the other endians", we may have to
  ; fix it
  IF DIDA.NeedSwap THEN BYTEORDER, catalog, /lswap
  ; Having an "array of longints" is quite nice, but it
  ; does not reflect the internal structure of the catalogue,
  ; which is made from catalogue entries:
  catentry = { catentrytyp, $ 
               ObjectNr:0L, $  ;..belongs to object Nr.
               Key:0L, $       ;..with data descriptor
               FullBytes:0L, $ ;..Number of significant bytes
               ClusterNr:0L }  ;..is the ordinal with respect to the object
                               ; The last cluster of an object is indicated
                               ; by a negative sign.

  cat = REPLICATE({catentrytyp},DIDA.CatSize)
  ; Now it would be fine, if one could simply copy the content
  ; of catalog "byte by byte" to cat.
  FOR I = 0, DIDA.CatSize-1 DO BEGIN
    cat(I).ObjectNr = catalog(4*I)
    cat(I).Key      = catalog(4*I+1)
    cat(I).FullBytes= catalog(4*I+2)
    cat(I).ClusterNr= catalog(4*I+3)
  ENDFOR

  RETURN, cat
END ; Function _NEXT_CATPAGE

FUNCTION _MAXCLUSTER, DIDA, CATPAGE, OBJ, KEY
;        ===========
; Search the maximum cluster index associated with the
; partial vector ( OBJ, KEY ). This procedure is useful,
; if one intends to know, how many data clusters are
; associated with (OBJ, KEY). MAXCLUS will be returned.
; If the partial vector (OBJ, KEY) is not in the file,
; a value of -1 will be returned
  IF NOT DIDA.OPEN THEN RETURN, -1
  IF DIDA.ERROR THEN RETURN, -1

  _REWIND, DIDA
  CATPAGE = _NEXT_CATPAGE( DIDA )

  FOUND = 0
  REPEAT BEGIN
    IF DIDA.ERROR THEN RETURN, -1
    I = -1
    WHILE ( I LT DIDA.CatSize-1 ) AND (NOT FOUND) DO BEGIN
      I = I+1
      FOUND = (CatPage(I).ObjectNr EQ OBJ) AND $ ;Partial vector
              (CatPage(I).Key EQ KEY) AND $      ;must fit
              (CatPage(I).FullBytes GT 0) AND $  ;Cluster must have data
              (CatPage(I).ClusterNr LT 0)        ;LastCluster indicator
    ENDWHILE                                     ;must be set
     
    IF FOUND THEN RETURN, -CatPage(I).ClusterNr $
             ELSE BEGIN
                    CATPAGE = _NEXT_CATPAGE( DIDA )
                    IF DIDA.CatPos LT 0 THEN RETURN, -1
                  ENDELSE
  ENDREP UNTIL FOUND

  RETURN, -1
END ; Function _MAXCLUSTER

PRO _FIRST_KEY, DIDA, CATPAGE, OBJ, KEY, FIRSTCLU
;   ==========
; Input: DIDA, CATPAGE, OBJ. Output: KEY, FIRSTCLU
; Offers the first key and the first cluster number
; associated with it in the OBJ.
; If FIRSTCLU is -1, there is no key associated
; with the object.

  FIRSTCLU = -1L
  IF DIDA.OPEN AND (NOT DIDA.ERROR) THEN BEGIN
    _REWIND, DIDA
    CatPage = _NEXT_CATPAGE( DIDA )
    REPEAT BEGIN
      IF DIDA.ERROR THEN RETURN
      I = -1
      FOUND = 0
      WHILE (I LT DIDA.CatSize-1) AND (NOT FOUND) DO BEGIN
        I = I+1
        FOUND = (CatPage(I).ObjectNr EQ OBJ) AND $
                (CatPage(I).FullBytes GT 0)
      ENDWHILE

      IF FOUND THEN BEGIN
        KEY    = CatPage(I).Key
        FIRSTCLU = ABS(CatPage(I).ClusterNr)
        ; Following two lines, if one wants to offer MAXCLU
        ; instead of FIRSTCLU
        ;IF CatPage(I).ClusterNr LT 0 THEN RETURN $
        ;ELSE MAXCLU = _MAXCLUSTER( DIDA, CatPage, OBJ, KEY )
        RETURN
      ENDIF ELSE BEGIN
        CatPage = _NEXT_CATPAGE( DIDA )
        IF DIDA.CatPos LT 0 THEN RETURN
      ENDELSE
    ENDREP UNTIL (DIDA.CatPos LT 0) OR FOUND
  ENDIF
  RETURN
END ; Procedure _FIRST_KEY

PRO _NEXT_KEY, DIDA, CATPAGE, OBJ, KEY, FIRSTCLU
;   =========
; Offers the key after KEY and the first cluster number
; associated with it in the OBJ.
; Input: DIDA, CATPAGE, OBJ, KEY. Output: KEY, FIRSTCLU
; If FIRSTCLU = -1, there was no "next key"
  FIRSTCLU = -1L
  IF DIDA.ERROR THEN RETURN
  IF (NOT DIDA.OPEN) THEN RETURN

  ; First search for the key, which was given
  _REWIND, DIDA
  CatPage = _NEXT_CATPAGE( DIDA )
  REPEAT BEGIN
    IF DIDA.ERROR THEN RETURN
    I = -1
    FOUND = 0
    WHILE (I LT DIDA.CatSize-1) AND (NOT FOUND) DO BEGIN
      I = I+1
      FOUND = (CatPage(I).ObjectNr EQ OBJ) AND $
              (CatPage(I).Key EQ Key) AND $
              (CatPage(I).FullBytes GT 0)
    ENDWHILE
    IF FOUND THEN BEGIN
      REPEAT BEGIN
        FOUNDNEXT = 0
        WHILE (I LT DIDA.CatSize-1) AND (NOT FOUNDNEXT) DO BEGIN
          I = I+1
          FOUNDNEXT = ( CatPage(I).ObjectNr EQ OBJ ) AND $
                      (CatPage(I).Key NE KEY) AND $
                      (CatPage(I).FullBytes GT 0)
        ENDWHILE
        IF FOUNDNEXT THEN BEGIN
          KEY = CatPage(I).Key
          FIRSTCLU = ABS(CatPage(I).ClusterNr)
          ;The following two lines of code, if one intends to
          ;offer MAXCLU instead of FIRSTCLU
          ;IF CatPage(I).ClusterNr LT 0 THEN RETURN $
          ;ELSE MAXCLU = _MAXCLUSTER( DIDA, CatPage, OBJ, KEY )
          RETURN
        ENDIF ELSE BEGIN
          CatPage = _NEXT_CATPAGE( DIDA )
          IF (DIDA.CatPos LT 0) THEN RETURN
        ENDELSE
      ENDREP UNTIL FOUNDNEXT

    ENDIF ELSE BEGIN
      CatPage = _NEXT_CATPAGE( DIDA )
      IF (DIDA.CatPos LT 0) THEN RETURN
    ENDELSE    
  ENDREP UNTIL (DIDA.CatPos LT 0) OR FOUND
  RETURN
END ; Procedure _NEXT_KEY

PRO _OBJECTDOC, DIDA, CATPAGE, OBJ
;   ==========
; Input: an OBJ number.
; Output: A documentation of the hierarchical organization of the
;         object.

  _REWIND, DIDA
  CatPage = _NEXT_CATPAGE( DIDA )
  KEY = -1L
  CLU = 1L
  _FIRST_KEY, DIDA, CatPage, OBJ, KEY, CLU
  IF CLU LT 0 $
    THEN BEGIN
           PRINT, 'Object ', STRTRIM(OBJ,2),' is empty'
         ENDIF $
    ELSE BEGIN
           PRINT, 'Object ', STRTRIM(OBJ,2), ':'

;          Descr = _GET_DESCRIPTOR( DIDA, CatPos, OBJ )
;          _DESCRIPTORDOC, Descr

           PRINT,'         key    1st page   last page'
           REPEAT BEGIN
             MAXCLU = _MAXCLUSTER( DIDA, CatPage, OBJ, KEY )
             PRINT, KEY, CLU, MAXCLU
             _NEXT_KEY, DIDA, CatPage, OBJ, KEY, CLU
           ENDREP UNTIL (DIDA.ERROR OR (CLU EQ -1))
    ENDELSE  
  RETURN
END ; Procedure _OBJECTDOC

FUNCTION _GET_DATAPAGE, DIDA, CATPAGE, OBJ, KEY, CLU
;        =============
; By using CatPage, any specific data page may be read,
; if it is identified by the vector (OBJ, KEY, CLU).
; Valid keys with respect to an object can be retrieved
; by calling _FIRST_KEY and _NEXT_KEY, which as well give
; the first cluster number. The maximum cluster number may
; be found via the function _MAXCLUSTER.
;
; This function does bookkeeping in the DIDA structure:
; DIDA.DataBytes is set to the number of valid bytes in the
;                data page. If set to "-1", the specified
;                data page was not found while reading up to
;                the end of the file. In this case The file
;                is already rewound and a second try may be
;                successful.
; DIDA.DataLast becomes true, if the page read was the
;               last page of the partial vector ( OBJ, KEY ).
; Result: An array of Bytes. Endian switch not yet considered.
;
  DataPage = BYTARR(DIDA.ClusSize)
  DIDA.DataBytes = -1

  IF NOT DIDA.OPEN THEN RETURN, DataPage 
  IF DIDA.ERROR THEN RETURN, DataPage 

  ; If CatPage is valid, then go on and try sequentially,
  ; but read the catalogue after a rewind request.
  IF DIDA.CatPos LT 0 THEN CatPage = _NEXT_CATPAGE( DIDA )

  ; vector search
  FOUND = 0
  REPEAT BEGIN
    IF DIDA.ERROR THEN RETURN, DataPage
    I = -1
    WHILE ( I LT DIDA.CatSize-1 ) AND (NOT FOUND) DO BEGIN
      I = I+1
      FOUND = (ABS(CatPage(I).ClusterNr) EQ CLU) AND $
                  (CatPage(I).Key EQ KEY) AND $
                  (CatPage(I).ObjectNr EQ OBJ) AND $
                  (CatPage(I).FullBytes GT 0)
    ENDWHILE

    IF FOUND $
      THEN BEGIN
             ; Content of DataPage is accessed indirectly by
             ; an offset I+1 from CatPage.
             DataPage = _GET_ABSOLUTE( DIDA, DIDA.CatPos+I+1 )
             ; Bookkeeping
             DIDA.DataBytes = CatPage(I).FullBytes
             DIDA.DataLast = CatPage(I).ClusterNr LT 0
             RETURN, DataPage
           ENDIF $
      ELSE BEGIN
             CatPage = _NEXT_CATPAGE( DIDA )
             ; Unsuccessful return at end of file
             IF DIDA.CatPos LT 0 THEN RETURN, DataPage
    ENDELSE

  ENDREP UNTIL FOUND
  RETURN, DataPage
END ; Function _GET_DATAPAGE


FUNCTION _GET_DESCRIPTOR, DIDA, CATPAGE, OBJ
;        ===============
; This function is the first step of object interpretation
; and is based on definitions by Rainer Steube. Every object
; must be described by a special DataPage, defined by the
; vector ( OBJ, KEY=0, CLU=1). The ObjectDescriptorPage holds
; information defined by R. Steube.
;
; The FieldWidth helps with the question, how to handle the
; "Endian" problem in the case that DIDA.NeedSwap is set.
; If FieldWidth = 1, then no action is necessary.
;               = 2, then byteorder, <block>, /sswap
;               = 4, then byteorder, <block>, /lswap
; is necessary to correct the "Endian" problem.
;
; Most important is the field NumberFormat, which needs explanation:
; = 1 WORD (0..65536 caution! Has no sign and pv-wave only knows integers)
; = 2 LONGINT format 
; = 3 BYTE (0..255)
; = 4 VAXSingle format (not IEEE; needs special treatment)
; = 6 INTEGER format
; = 7 IEEESingle format

  Descriptor = {DesTyp, $
                   Dimension:0L, $
                   NumberFormat:0L, $
                   FieldWidth:0L, $
                   X_Pixel:0L, $
                   Y_Pixel:0L } 
  
  ODP = _GET_DATAPAGE( DIDA, CatPage, OBJ, 0, 1 )
  ; Make it LongInts
  ODP = LONG( ODP, 0, DIDA.ClusSize/4 )
  ; Consider Endian switch
  IF DIDA.NeedSwap THEN BYTEORDER, ODP, /lswap

  ; Interpret the ODP
  Descriptor.Dimension = ODP(0)
  Descriptor.NumberFormat = ODP(1)
  Descriptor.FieldWidth = ODP(2)
  Descriptor.X_Pixel = ODP(16)
  Descriptor.Y_Pixel = ODP(17)
  RETURN, Descriptor
END ; Function _GET_DESCRIPTOR

PRO _DESCRIPTORDOC, DES
;   ==============
; Documents the contents of the Object descriptor
  
  PRINT, STRTRIM(DES.Dimension,2),'-dimensional data'
  NF='Number format: '
  CASE DES.NumberFormat OF
    1: PRINT,NF,'WORD'
    2: PRINT,NF,'LONG Integer'
    3: PRINT,NF,'BYTE'
    4: PRINT,NF,'VAX-SINGLE'
    6: PRINT,NF,'INTEGER'
    7: PRINT,NF,'SINGLE'
  ELSE: PRINT,NF,'unknown'
  ENDCASE

  IF DES.Dimension EQ 2 THEN BEGIN
    PRINT, 'Image width:  ', STRTRIM(DES.X_Pixel,2)
    PRINT, 'Image height: ', STRTRIM(DES.Y_Pixel,2)
  ENDIF
  RETURN
END ; Procedure _DESCRIPTORDOC

FUNCTION _GET_NAME, DIDA, CatPage, OBJ
;        =========
; Retrieves the name of the object which, according to
; R. Steube's convention, is stored in a datapage
; under vector (OBJ, -1, 1).

  name = ' '
  namepage = _GET_DATAPAGE( DIDA, CatPage, OBJ, -1, 1 )

  IF DIDA.DataBytes GT 0 THEN BEGIN
    namepage = namepage(0:DIDA.DataBytes-1)
    name = STRING( namepage )
  ENDIF
  RETURN, name
END ; Function _GET_NAME

; --------------------------------------------------------

FUNCTION DIDATEST, file
;        ========
;
  ON_ERROR, 2
  ;Make dummy result
  result = 0

  ;-----Begin: Check the parameters of this function-----

  ;***Check the parameters
  ;? parameter file present?
  IF NOT PARAM_PRESENT( file ) THEN BEGIN
      PRINT, 'Syntax error. Parameter <filename> is missing!'
      PRINT, 'Call: result = didaread( ''file'' )'
      RETURN, result
    ENDIF
  ;? is file a string?
  ;- remember: size() gives a lot of information on the variable.
  TypCheck = SIZE( file )
  IF TypCheck(1+TypCheck(0)) NE 7 THEN BEGIN
      PRINT, 'Syntax error. Parameter <filename> is no string!'
      RETURN, result
    ENDIF
  ;? Append default extension '.cpf'?
  IF STRPOS( file, '.' ) < 0 THEN file = file + '.cpf'

  ;-----Begin: Generate file control block-----
  DIDA={ STATUSTYP, $
           LUN:0L, $        ; The LUN associated to the file
           ERROR:0, $       ; Was there an error?
           OPEN:0, $        ; Is file open?
           NeedSwap:0, $    ; Need to swap the data to other endians?
           Clusters:0L, $   ; Number of clusters in file
           HiObjNr:0L, $    ; Number of objects stored in file
           ClusSize:0L, $   ; Size of each cluster in bytes
           LastCatP:0L, $   ; Number of full clusters (pages) in file
           CATSIZE:0L, $    ; Number of CatEntries per CatPage
           CATPOS:-1L, $    ; Position of the actual CatPage in the file
           DATABYTES:0L, $  ; Valid data bytes in the last read data page
           DATALAST:0L $    ; Was last datapage the last page of the object?
       }
     
  ;-----Begin: Retrieve the sesame information of DIDA-----
  SESAM = _OPEN_SESAME( file )
  ; error?
  IF (SESAM.Clusters LT 1) THEN BEGIN $
    PRINT, 'File ', file, ' could not be opened'
    RETURN, 0
  ENDIF

  ; Check basic cluster syntax
  IF (SESAM.ClusSize LT 64) OR (SESAM.ClusSize GT '4000'xL) $
    OR ((SESAM.ClusSize MOD 16) NE 0) THEN BEGIN $
    PRINT, 'Cluster size',SESAM.ClusSize,' does not meet specifications'
    RETURN, 0
  ENDIF
  ; Document the primary file structure
  _DIDADOC, file, SESAM

  ; Copy from sesame block into file control block
  DIDA.NeedSwap = SESAM.NeedSwap
  DIDA.Clusters = SESAM.Clusters
  DIDA.HiObjNr  = SESAM.HiObjNr
  DIDA.LastCatP = SESAM.LastCatP
  DIDA.ClusSize = SESAM.ClusSize
  ; Compute number of catalogue entries per catalog cluster
  DIDA.CatSize = LONG( DIDA.ClusSize / 16 )

  ;-----Begin: Open file for reading-----
  GET_LUN, DIDAlun
  ON_IOERROR, close_with_ioerr
  ON_ERROR_GOTO, close_and_return1

  DIDA.lun = DIDAlun
  OPENR, DIDA.lun, file
  DIDA.open = 1 EQ 1

  
  _REWIND, DIDA
  CatPage = _NEXT_CATPAGE( DIDA )

  ; Result of this version is only a printout of all objects
  ; and their properties.
  FOR I = 1,DIDA.HiObjNr DO BEGIN
    _OBJECTDOC, DIDA, CatPage, I
    Des = _GET_DESCRIPTOR( DIDA, CatPage, I )
    _DESCRIPTORDOC, Des
    PRINT, 'Name: ', _GET_NAME( DIDA, CatPage, I )
    PRINT, '------------------------------------'
  ENDFOR

  ; For normal closing:
  GOTO, close_and_return1

  ;-----Begin: The closings-----
close_with_ioerr:
  PRINT, !Err,': ',!Err_String
close_and_return1:
  CLOSE, DIDA.lun
  FREE_LUN, DIDAlun

  RETURN, result
END ; End Function DIDATEST