; $Id: read_wave.pro,v 1.13 2004/01/21 15:55:00 scottm Exp $
;
; Copyright (c) 1990-2004, Research Systems, Inc.  All rights reserved.
;       Unauthorized reproduction prohibited.

FUNCTION getword, BIN = BIN

COMPILE_OPT hidden
COMMON waverdln, unit

ON_IOERROR, done

IF (KEYWORD_SET(BIN)) THEN BEGIN
  wordlen = 0L
  READU, unit, wordlen
  theword = bytarr(wordlen)
  READU, unit, theword
ENDIF ELSE BEGIN
  filestat = FSTAT(unit)
  current = filestat.cur_ptr
  buffsize = 100 < (filestat.size - current)
  linebuffer = bytarr(100)
  READU, unit, linebuffer
  i = 0
  WHILE (linebuffer[i] EQ 32) OR (linebuffer[i] EQ 10) DO i = i + 1
  wordstart = i
  WHILE (linebuffer[i] NE 32) AND (linebuffer[i] NE 10) DO i = i + 1
  theword = linebuffer[wordstart:i - 1]
  POINT_LUN, unit, current + i
ENDELSE

return, string(theword)

RETURN, STRCOMPRESS(STRING(theword[WHERE(theword NE 10)]), /REMOVE_ALL)

done: RETURN, ""

END


FUNCTION getdef, BIN = BIN, BLOCK = BLOCK

COMPILE_OPT hidden
COMMON waverdln, unit

ON_IOERROR, done

IF (KEYWORD_SET(BIN)) THEN BEGIN
  IF (KEYWORD_SET(BLOCK)) THEN BEGIN
    def = 0L
    READU, unit, def
    IF (def NE 257L) THEN MESSAGE, "Error, " +$
		"definition expected in binary read (" + def + ")"
  ENDIF
  type = 0L
  READU, unit, type
ENDIF ELSE BEGIN
  IF (KEYWORD_SET(BLOCK)) THEN BEGIN
    def = getword(BIN = BIN)
    IF (def EQ "") THEN GOTO, done
    IF (STRMID(def, 0, 1) EQ "#") THEN BEGIN
      ignore = ""
      READF, unit, ignore
      def = getword(BIN = BIN)
    ENDIF
    IF (def NE "define") THEN $
      MESSAGE, "Error, definition expected in text read (" + def + ")"
  ENDIF
  type = getword(BIN = BIN)
  CASE type OF
    "vdata": 		type = 258L
    "reg_topology": 	type = 259L
    "elem_samp": 	type = 260L
    "irr_topology":	type = 262L
    "count":		type = 263L
    "elems":		type = 264L
    "reg_grid": 	type = 265L
    "grid_samp": 	type = 266L
    "origin": 		type = 267L
    "step":		type = 268L
    "irr_grid":		type = 270L
    "node_vdata":	type = 271L
    "mesh": 		type = 273L
    "mesh_topology":	type = 274L
    "mesh_grid":	type = 275L
    "volume": 		type = 276L
    "volume_mesh":	type = 277L
    "volume_vdata":	type = 278L
    ELSE: BEGIN
	    MESSAGE, type + " was the unrecognized type"
	  END
  ENDCASE
ENDELSE

RETURN, type

done: RETURN, -1L

END


FUNCTION getnum, BIN = BIN

COMPILE_OPT hidden
COMMON waverdln, unit

IF (KEYWORD_SET(BIN)) THEN BEGIN
  num = 0L
  READU, unit, num
ENDIF ELSE BEGIN
  num = LONG(getword(BIN = BIN))
ENDELSE
  return, num
END

FUNCTION readarray, len

COMPILE_OPT hidden
COMMON waverdln, unit

line = ""
READF, unit, line
endofline = fstat(unit)
current = endofline.cur_ptr

valueline = SHIFT(BYTE(STRCOMPRESS(line)), -1)
spaces = WHERE(valueline EQ 32, numspaces)
IF (numspaces NE 0) THEN BEGIN
  values = INTARR(len)
  last = 0
  FOR i = 0, numspaces - 1 DO BEGIN
    values[i] = STRING(valueline[last:spaces[i] - 1])
    last = spaces[i]
  ENDFOR
ENDIF

return, values
END


PRO read_wave, filename, variables, names, dimensions, $
		MESHNAMES = MESHNAMES
;+
; NAME:
;	READ_WAVE
; PURPOSE:
;	READ a .wave or .bwave file created by the Advanced Data Visualizer
;	into an series of IDL variables.
; CALLING SEQUENCE:
;	READ_WAVE, FILE, VARIABLES, NAMES, DIMENSIONS
; INPUTS:
;	FILE = Scalar string giving the name of the Wavefront file to write.
; KEYWORD PARAMETERS:
;	MESHNAMES = The name of the mesh used in the Wavefront file
;		for each variable.
; OUTPUTS:
;	VARIABLES = Upon return, this variable contains a block of the 
;		variables contained in the wavefront file.  Since each
;		variable in a wavefront file can have more than one field
;		(for instance, a vector variable has 3 fields), the fields
;		of each variable make up the major index into the variable 
;		block.  For instance, if a Wavefront file had one scalar 
;		variable and one vector variable, the scalar would be
;		extracted as follows:
;
;			vector_scalar = variables[0,*,*,*]
;
;		and the vector variable would be extracted as follows:
;
;			vector_variable = variables[1:3,*,*,*]
;
;		To find the dimensions of the returned variable, see the
;		description below regarding DIMENSIONS
;
;	NAMES = Upon return, this variable contains the string names of each
;		variable contained in the file.
;	DIMENSIONS = Upon return, this variable is a long array that describes
;		how many fields in the large returned variable block each
;		variable occupies.  In the above example of one scalar variable
;		followed by a vector variable, the dimension variable would 
;		be:
;			DIMENSIONS = [1,3]
;		So the first field of the returned variable block would be
;		the scalar variable and the following 3 fields would comprise
;		the vector variable.
; RESTRICTIONS:
;	This routine only preserved the structure of the variables if they
;	are regularly grided variables.  
; MODIFICATION HISTORY:
;	Written July 16, 1991, by Steve Richards.
;-
;

COMMON waverdln, unit

IF (KEYWORD_SET(DEBUG)) THEN DEBUG = 1 ELSE DEBUG = 0

volnum = 0
voldesclist = 0
voldesc = {vldesc,	name:"", $
  			volmeshdesc:"", $
  			voldata:""}
meshnum = 0
meshdesclist = 0
meshdesc = {mshdesc,	name:"", $
			topdesc:"", $
			griddesc:""}
topnum = 0
topdesclist = 0
topdesc = {tpdesc,	name:"", $
			elem_samp:intarr(8)}
gridnum = 0
griddesclist = 0
griddesc = {grddesc,	name:"", $
			grid_samp:intarr(8)}

datafieldnum = 0
datafieldlist = 0
datafield = {dtfld,	name:"", $
			size:0}

variables = 0

OPENR, unit, filename, /GET_LUN

adot = STRPOS(filename, ".")

WHILE (adot NE -1) DO BEGIN
  dot = adot
  adot = STRPOS(filename, ".", adot + 1)
END

ext = STRMID(filename, dot + 1, 100)

IF (ext EQ "bwave") THEN BIN = 1 ELSE BIN = 0

ON_IOERROR, done

curval = getdef(BIN = BIN, /BLOCK)
WHILE (curval NE -1) DO BEGIN				;while new blocks to
  CASE (curval) OF					;the definition type

    258L:BEGIN						;definevdata
	   newnumvars = getnum(BIN = BIN)
  	   newvarnames = strarr(newnumvars)
  	   newvardims = intarr(newnumvars) + 1
  	   FOR i = 0, newnumvars - 1 DO BEGIN		;determine variable
  	     newvarnames[i] = getword(BIN = BIN)	;names and dimensional
  	     parenth = STRPOS(newvarnames[i], "(", 0)	;information if it is
  	     IF(parenth NE -1) THEN BEGIN		;present
  	       newvardims[i] = FIX(STRMID(newvarnames[i], $
  				      parenth + 1, $
  				      10))
	       newvarnames[i] = STRMID(newvarnames[i], 0, parenth)
	       datafieldloc = where(datafieldlist.name EQ newvarnames[i])
	       datafieldlist[datafieldloc].size = $
			datafieldlist[datafieldloc].size * newvardims[i]
  	     ENDIF
  	   ENDFOR
	   newnumdatalines = getnum(BIN = BIN)
  	   newvars = FLTARR(TOTAL(newvardims), newnumdatalines)
	   IF (KEYWORD_SET(BIN)) THEN $
	     READU, unit, newvars $
	   ELSE $
	     READF, unit, newvars
	   varsize = SIZE(variables)
	   IF (varsize[0] EQ 0) THEN BEGIN
	     variables = newvars
	     numvars = newnumvars
	     varnames = newvarnames
	     vardims = newvardims
	   ENDIF ELSE BEGIN
	     newvariables = FLTARR(varsize[1] + $
			TOTAL(newvardims), newnumdatalines)
	     newvariables[0:varsize[1]-1,*] = variables
	     newvariables[varsize[1]:*,*] = newvars
	     variables = newvariables
	     numvars = numvars + newnumvars
	     varnames = [varnames, newvarnames]
	     vardims = [vardims, newvardims]
	   ENDELSE
	   END

    259L:BEGIN						;definereg_topology
           topnum = topnum + 1
           IF(KEYWORD_SET(topdesclist)) THEN $
             topdesclist = [topdesclist, topdesc] $
	   ELSE topdesclist = REPLICATE(topdesc, 1)
           topdesclist[topnum - 1].name = getword(BIN = BIN)
	   IF (getdef(BIN = BIN) NE 260L) THEN $	;if not elem_samp
	     MESSAGE, "incorrect format, elem_samp should" + $
			" follow define reg_topology"
	   topdesclist[topnum - 1].elem_samp[0] = getnum(BIN = BIN)
	   topdesclist[topnum - 1].elem_samp[1] = getnum(BIN = BIN)
	   topdesclist[topnum - 1].elem_samp[2] = getnum(BIN = BIN)
	   END

    262L:BEGIN						;define irr_topology
	   gridname = getword(BIN = BIN)
	   countdef = getdef(BIN = BIN)
	   IF (countdef NE 263L) THEN $
		MESSAGE, "incorrect format, count should " +$
			"follow define irr_topology"
	   count = getnum(BIN = BIN)
	   elemsdef = getdef(BIN = BIN)
	   IF (elemsdef NE 264L) THEN $
		MESSAGE, "incorrect format, elems should " +$
			"follow count definition"
	   elemsname = getword(BIN = BIN)
	   elemscount = getnum(BIN = BIN)
	   toss = intarr(4,elemscount)
	   IF (KEYWORD_SET(BIN)) THEN $
	     READU, unit, toss $
	   ELSE $
	     READF, unit, toss
	   toss = 0
	   END

    265L:BEGIN						;define reg_grid
           gridnum = gridnum + 1
           IF(KEYWORD_SET(griddesclist)) THEN $
             griddesclist = [griddesclist,griddesc] $
	   ELSE griddesclist = REPLICATE(griddesc, 1)
           griddesclist[gridnum - 1].name = getword(BIN = BIN)
	   IF (getdef(BIN = BIN) NE 266L) THEN $	;if not grid_samp
	     MESSAGE, "incorrect format, grid_samp should" + $
			" follow define reg_grid"
	   griddesclist[gridnum - 1].grid_samp[0] = getnum(BIN = BIN)
	   griddesclist[gridnum - 1].grid_samp[1] = getnum(BIN = BIN)
	   griddesclist[gridnum - 1].grid_samp[2] = getnum(BIN = BIN)
	   IF (getdef(BIN = BIN) NE 267L) THEN $	;if not origin
	     MESSAGE, "incorrect format, origin" + $
			" follow define grid_samp"
	   orig = fltarr(3)
	   orig[0] = getnum(BIN = BIN)
	   orig[1] = getnum(BIN = BIN)
	   orig[2] = getnum(BIN = BIN)
	   IF (getdef(BIN = BIN) NE 268L) THEN $	;if not step
	     MESSAGE, "incorrect format, step" + $
			" follow define origin"
	   steps = FLTARR(3)
	   steps[0] = getnum(BIN = BIN)
	   steps[1] = getnum(BIN = BIN)
	   steps[2] = getnum(BIN = BIN)
	   END

    270L:BEGIN						;defineirr_grid
	   gridname = getword(BIN = BIN)
	   griddef = getdef(BIN = BIN)
	   IF (griddef NE 271) THEN $
		MESSAGE, "incorrect format, grid_vdata should " +$
			"follow define irr_grid"
	   datafieldnum = datafieldnum + 1
           IF(KEYWORD_SET(datafieldlist)) THEN $
             datafieldlist = [datafieldlist, datafield] $
	   ELSE datafieldlist = REPLICATE(datafield, 1)
           datafieldlist[datafieldnum - 1].name = getword(BIN = BIN)
	   datafieldlist[datafieldnum - 1].size = -1
	   END

    273L:BEGIN						;definemesh
           meshnum = meshnum + 1
           IF(KEYWORD_SET(meshdesclist)) THEN $
             meshdesclist = [meshdesclist, meshdesc] $
           ELSE meshdesclist = REPLICATE(meshdesc, 1)
           meshdesclist[meshnum - 1].name = getword(BIN = BIN)
	   IF (getdef(BIN = BIN) NE 274L) THEN $	;if not mesh_topology
	     MESSAGE, "incorrect format, mesh_topology should" + $
			" follow define mesh"
	   meshdesclist[meshnum - 1].topdesc = getword(BIN = BIN)
	   IF (getdef(BIN = BIN) NE 275L) THEN $	;if not mesh_grid
	     MESSAGE, "incorrect format, mesh_grid" + $
			" follow define mesh_topology"
	   meshdesclist[meshnum - 1].griddesc = getword(BIN = BIN)
	   END

    276L:BEGIN						;definevolume
	     volnum = volnum + 1
             IF(KEYWORD_SET(voldesclist)) THEN $
               voldesclist = [voldesclist,voldesc] $
	     ELSE voldesclist = REPLICATE(voldesc, 1)
             voldesclist[volnum - 1].name = getword(BIN = BIN)
	     IF (getdef(BIN = BIN) NE 277L) THEN $	;if not define vol_mesh
	       MESSAGE, "incorrect format, volume_mesh should" + $
			" follow define volume"
	     voldesclist[volnum - 1].volmeshdesc = getword(BIN = BIN)
	     IF (getdef(BIN = BIN) NE 278L) THEN $     ;if not define vol_dvata
	       MESSAGE, "incorrect format, volume_vdata should" + $
			" follow define volume_mesh"
	     voldesclist[volnum - 1].voldata = getword(BIN = BIN)
	     datafieldnum = datafieldnum + 1
             IF(KEYWORD_SET(datafieldlist)) THEN $
               datafieldlist = [datafieldlist, datafield] $
	     ELSE datafieldlist = REPLICATE(datafield, 1)
             datafieldlist[datafieldnum - 1].name = $
			voldesclist[volnum - 1].name
	     datafieldlist[datafieldnum - 1].size = 1
	   END
    ELSE: print, "no case for type ", curval
  ENDCASE
  curval = getdef(BIN = BIN, /BLOCK)
ENDWHILE

done:

FREE_LUN, unit

nomesh = 0

FOR i = 0, volnum - 1 DO BEGIN
  IF (meshnum EQ 0) OR (gridnum EQ 0) OR (topnum EQ 0) THEN BEGIN
    nomesh = 1
  ENDIF ELSE BEGIN
    meshloc = WHERE(voldesclist[i].volmeshdesc EQ $
 		  meshdesclist.name, meshfound)
    dataloc = WHERE(voldesclist[i].voldata EQ $
  		  varnames, datafound)
    IF ((NOT meshfound) OR (NOT datafound)) THEN nomesh = 1
    toploc = WHERE(meshdesclist[meshloc].topdesc EQ $
  		 topdesclist.name, topfound)
    gridloc = WHERE(meshdesclist[meshloc].griddesc EQ $
  		 griddesclist.name, gridfound)
    IF ((NOT topfound) OR (NOT gridfound))THEN nomesh = 1

    griddims = griddesclist[gridloc].grid_samp[ $
  	WHERE(griddesclist[gridloc].grid_samp NE 0)]
  ENDELSE
ENDFOR

IF NOT(nomesh) THEN BEGIN
  variables = reform(variables, [TOTAL(vardims), griddims])
  MESHNAMES = meshdesclist.name
ENDIF

names = voldesclist.name

startindex = 0
FOR i = 0, datafieldnum - 1 DO BEGIN
  IF(datafieldlist[i].size GE 1) THEN BEGIN
    IF (KEYWORD_SET(validdata)) THEN BEGIN
      validdata = [validdata, INDGEN(datafieldlist[i].size) + startindex]
      dimensions = [dimensions, datafieldlist[i].size]
    ENDIF ELSE BEGIN
      validdata = INDGEN(datafieldlist[i].size) + startindex
      dimensions = datafieldlist[i].size
    ENDELSE
  ENDIF
  startindex = startindex + ABS(datafieldlist[i].size)
ENDFOR

variables = variables[validdata, *, *, *]

END