diff options
Diffstat (limited to 'ipl/procs/ddfread.icn')
| -rw-r--r-- | ipl/procs/ddfread.icn | 419 |
1 files changed, 419 insertions, 0 deletions
diff --git a/ipl/procs/ddfread.icn b/ipl/procs/ddfread.icn new file mode 100644 index 0000000..8fdcc4c --- /dev/null +++ b/ipl/procs/ddfread.icn @@ -0,0 +1,419 @@ +############################################################################ +# +# File: ddfread.icn +# +# Subject: Procedures for reading ISO 8211 DDF files +# +# Author: Gregg M. Townsend +# +# Date: August 2, 2001 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# These procedures read DDF files ("Data Descriptive Files", +# ISO standard 8211) such as those specified by the US Geological +# Survey's "Spatial Data Transfer Standard" for digital maps. +# ISO8211 files from other sources may contain additional data +# encodings not recognized by these procedures. +# +# ddfopen(filename) opens a file and returns a handle. +# ddfdda(handle) returns a list of header records. +# ddfread(handle) reads the next data record. +# ddfclose(handle) closes the file. +# +############################################################################ +# +# ddfopen(filename) opens a DDF file, decodes the header, and +# returns an opaque handle for use with subsequent calls. It +# fails if any problems are encountered. Instead of a filename, +# an already-open file can be supplied. +# +############################################################################ +# +# ddfdda(handle) returns a list of records containing data +# from the Data Descriptive Area (DDA) of the file header. +# Each record contains the following fields: +# +# tag DDR entry tag +# control field control data +# name field name +# labels list of field labels +# format data format +# +# The records may also contain other fields used internally. +# +############################################################################ +# +# ddfread(handle) reads the next data record from the file. +# It returns a list of lists, with each sublist containing +# a tag name followed by the associated data values, already +# decoded according to the specification given in the header. +# +############################################################################ +# +# ddfclose(handle) closes a DDF file. +# +############################################################################ + + + +$define RecSep "\x1E" # ASCII Record Separator +$define UnitSep "\x1F" # ASCII Unit Separator +$define EitherSep '\x1E\x1F' # either separator, as cset + +$define LabelSep "!" # label separator +$define AnySep '!\x1E\x1F' # any separator, as cset + + + +record ddf_info( # basic DDF file handle + file, # underlying file + header, # last header + dlist, # DDA list (of ddf_dde records) + dtable # DDA table (indexed by tag) + ) + + +record ddf_header( # DDF header information + hcode, # header code (R if to reuse) + dlen, # data length + ddata, # dictionary data (as a string) + tsize, # size of tag field in dictionary + lsize, # size of length field + psize, # size of position field + s # header string + ) + + +record ddf_dde( # data description entry + tag, # record tag + control, # field control + name, # field name + rep, # non-null if labels repeat to end of record + labels, # list of labels + format, # format + dlist # decoder list + ) + + +record ddf_decoder( # field decoder record + proc, # decoding procedure + arg # decoder argument + ) + + + +######################### PUBLIC PROCEDURES ######################### + + + +# ddfopen(filename) -- open DDF file for input +# +# Opens a DDF file, decodes the header, and returns an opaque handle h +# for use with ddfread(h). Fails if any problems are found. + +procedure ddfopen(fname) #: open DDF file + local f, h, p, l, t, e + + if type(fname) == "file" then + f := fname + else + f := open(fname, "ru") | fail + + h := ddf_rhdr(f) | fail + p := ddf_rdata(f, h) | fail + l := dda_list(p) | fail + t := table() + every e := !l do + t[e.tag] := e + return ddf_info(f, h, l, t) +end + + + +# ddfdda(handle) -- return list of DDAs +# +# Returns a list of Data Descriptive Area records containing the +# following fields: +# +# tag DDR entry tag +# control field control data +# name field name +# labels list of field labels +# format data format +# +# (There may be other fields present for internal use.) + +procedure ddfdda(handle) + return handle.dlist +end + + + + +# ddfread(handle) -- read DDF record +# +# Reads the next record using a handle returned by ddfopen(). +# Returns a list of lists, each sublist consisting of a +# tag name followed by the associated data values + +procedure ddfread(handle) #: read DDF record + local h, p, dlist, code, data, drec, sublist, e, n + + h := handle.header + if h.hcode ~== "R" then + h := handle.header := ddf_rhdr(handle.file) | fail + p := ddf_rdata(handle.file, h) | fail + dlist := list() + while code := get(p) do { + data := get(p) + drec := \handle.dtable[code] | next # ignore unregistered code + put(dlist, sublist := [code]) + data ? { + n := -1 + while *sublist > n do { # bail out when no more progress + n := *sublist + every e := !drec.dlist do # crack according to format + every put(sublist, e.proc(e.arg)) + if pos(-1) then + =RecSep + if pos(0) then # quit more likely here + break + } + } + } + return dlist +end + + + +# ddfclose(handle) -- close DDF file + +procedure ddfclose(handle) #: close DDF file + close(\handle.file) + every !handle := &null + return +end + + + +######################### INTERNAL PROCEDURES ######################### + + + +# ddf_rhdr(f) -- read DDF header record + +procedure ddf_rhdr(f) + local s, t, tlen, hcode, off, nl, np, nx, nt, ddata + + s := reads(f, 24) | fail + *s = 24 | fail + s ? { + tlen := integer(move(5)) | fail + move(1) + hcode := move(1) + move(5) + off := integer(move(5)) | fail + move(3) | fail + nl := integer(move(1)) | fail + np := integer(move(1)) | fail + nx := move(1) | fail + nt := integer(move(1)) | fail + } + ddata := reads(f, off - 24) | fail + *ddata = off - 24 | fail + + return ddf_header(hcode, tlen - off, ddata, nt, nl, np, s) +end + + + +# ddf_rdata(f, h) -- read data, returning code/value pairs in list + +procedure ddf_rdata(f, h) + local tag, len, posn, data, a, d + + d := reads(f, h.dlen) | fail + if *d < h.dlen then fail + a := list() + h.ddata ? while not pos(0) do { + if =RecSep then break + tag := move(h.tsize) | fail + len := move(h.lsize) | fail + posn := move(h.psize) | fail + data := d[posn + 1 +: len] | fail + put(a, tag, data) + } + return a +end + + + +# dda_list(pairs) -- build DDA list from tag/data pairs + +procedure dda_list(p) + local l, labels, tag, spec, control, name, format, d, rep + + l := list() + while tag := get(p) do { + labels := list() + spec := get(p) | fail + spec ? { + control := move(6) | fail + name := tab(upto(EitherSep) | 0) + move(1) + rep := ="*" + while put(labels, tab(upto(AnySep))) do { + if =LabelSep then next + move(1) + break + } + format := tab(upto(EitherSep) | 0) + move(1) + pos(0) | fail + } + d := ddf_dtree(format) | fail + put(l, ddf_dde(tag, control, name, rep, labels, format, d)) + } + + return l +end + + + +# ddf_dtree(format) -- return tree of decoders for format +# +# keeps a cache to remember & share decoder lists for common formats + +procedure ddf_dtree(format) + static dcache + initial { + dcache := table() + dcache[""] := [ddf_decoder(ddf_str, EitherSep)] + } + + /dcache[format] := ddf_fcrack(format[2:-1]) + return dcache[format] +end + + + +# ddf_fcrack(s) -- crack format string + +procedure ddf_fcrack(s) + local dlist, n, d + + dlist := list() + s ? while not pos(0) do { + + if (any(&digits)) then + n := tab(many(&digits)) + else + n := 1 + + d := &null + d := case move(1) of { + ",": next + "A": ddf_oneof(ddf_str, ddf_strn) + "B": ddf_oneof(&null, ddf_binn, 8) + "I": ddf_oneof(ddf_int, ddf_intn) + "R": ddf_oneof(ddf_real, ddf_realn) + "(": ddf_decoder(ddf_repeat, ddf_fcrack(tab(bal(')')), move(1))) + } + if /d then fail + every 1 to n do + put(dlist, d) + } + return dlist +end + + + +# ddf_oneof(tabproc, moveproc, quantum) -- select one of two procs + +procedure ddf_oneof(tabproc, moveproc, quantum) + local d, n + + if not ="(" then + return ddf_decoder(tabproc, EitherSep) + + if any(&digits) then { + /quantum := 1 + n := integer(tab(many(&digits))) + n % quantum = 0 | fail + d := ddf_decoder(moveproc, n / quantum) + } + else { + d := ddf_decoder(\tabproc, move(1) ++ EitherSep) | fail + } + + =")" | fail + return d +end + + + +######################### DECODING PROCEDURES ######################### + + + +procedure ddf_str(cs) # delimited string + return 1(tab(upto(cs)), move(1)) +end + +procedure ddf_strn(n) # string of n characters + return move(n) +end + +procedure ddf_int(cs) # delimited integer + local s + s := tab(upto(cs)) + move(1) + return integer(s) | 0 +end + +procedure ddf_intn(n) # integer of n digits + local s + s := move(n) + return integer(s) | 0 +end + +procedure ddf_real(cs) # delimited real + local s + s := tab(upto(cs)) + move(1) + return real(s) | 0.0 +end + +procedure ddf_realn(n) # real of n digits + local s + s := move(n) + return real(s) | 0.0 +end + +procedure ddf_binn(n) # binary value of n bytes + local v, c + v := c := ord(move(1)) + every 2 to n do + v := 256 * v + ord(move(1)) + if c < 128 then # if sign bit unset in first byte + return v + else + return v - ishift(1, 8 * n) +end + +procedure ddf_repeat(lst) # repeat sublist to EOR + local e + repeat { + every e := !lst do { + if (=RecSep | &null) & pos(0) then + fail + else + suspend e.proc(e.arg) + } + } +end |