home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP09.EXE / CHP0916.PRG < prev    next >
Encoding:
Text File  |  1991-06-01  |  4.0 KB  |  136 lines
  1. /*
  2.    Listing 9.16 and 9.17: Writes an array to a disk file.
  3.    Author: Craig Yellick
  4.    Excerpted from "Clipper 5: A Developer's Guide"
  5.    Copyright (c) 1991 M&T Books
  6.                       501 Galveston Drive
  7.                       Redwood City, CA 94063-4728
  8.                       (415) 366-3600
  9. */
  10.  
  11. function SaveArray(a_, fileName)
  12. /*
  13.    General-purpose function for saving an array to a disk file.
  14.    This is only the public interface. The real work is done by
  15.    recursive calls to the ElementOut() function.
  16.  
  17.    Pass an array (or a reference to an array) and the name of the
  18.    file to store the array.
  19.  
  20.        SaveArray({1,2,3,4}, "NUMS.ARY")
  21.  
  22.    This function returns .t. if successful, .f. if not.
  23. */
  24.  
  25. local cnt := len(a_)
  26. local success := .f.
  27. local handle := fcreate(fileName)
  28.  
  29.   if handle != -1
  30.      success := ElementOut(handle, a_)
  31.      fclose(handle)
  32.   endif
  33.  
  34. return success
  35.  
  36.  
  37. static function ElementOut(handle, a_)
  38. /*
  39.    Given a file handle and an array, write the contents of the
  40.    array to the file in the following form.
  41.  
  42.       LL T WW E... T WW E...
  43.  
  44.    Where LL is a two byte integer representing the number of
  45.    elements in the array, T is a character representing the data
  46.    type of the first element, WW is a two byte integer
  47.    representing the width of the element; followed by repetitions
  48.    of that basic pattern.
  49.  
  50.    Nested arrays are handled by calling ElementOut() when ever an
  51.    array is encountered within the elements in the array
  52.    currently being processed. (Know as recursion.)  The LL length
  53.    bytes are written following an "A" data type and the process
  54.    gets repeated. Isn't recursion wonderful?
  55.  
  56.    This is a static function and therefore not visible to any
  57.    functions outside of the source code file containing it. All
  58.    calls from the outside must be made to SaveArray().
  59.  
  60. */
  61.  
  62. local success := .t.
  63. local i, buffer
  64. local cnt := len(a_)
  65.  
  66.   //  Write the overall array size.
  67.   fwrite(handle, i2bin(cnt))
  68.  
  69.   //  Process each element in the array.
  70.   for i = 1 to cnt
  71.  
  72.      /*
  73.        Special handling for the nil and code block data types.
  74.        Both will be labeled type "Z" and for consistency wit the
  75.        other data types, will have a width of one and an element
  76.        value of "Z". However, a nil will be placed in the array
  77.        when it comes time to load it from the file.
  78.      */
  79.      if (a_[i] = nil) .or. (valtype(a_[i]) = "B")
  80.         buffer := "Z" +i2bin(1) +"Z"
  81.  
  82.      else
  83.         /*
  84.            Each element is encoded as follows.
  85.                Data type:  C,D,L,N.
  86.                    Width:  Number of characters needed.
  87.            Element Value:  String version of the value.
  88.         */
  89.  
  90.         buffer := valtype(a_[i])
  91.         do case
  92.         case buffer = "C"
  93.           buffer += i2bin(len(a_[i]))    //  Width of the string
  94.           buffer += a_[i]
  95.  
  96.         case buffer = "D"
  97.           buffer += i2bin(8)             //  Dates are 8 wide
  98.           buffer += dtoc(a_[i])
  99.  
  100.         case buffer = "L"
  101.           buffer += i2bin(1)             //  Logicals are 1 wide
  102.           buffer += if(a_[i], "T", "F")
  103.  
  104.         case buffer = "N"
  105.           //  Convert number to string, trim spaces, and
  106.           //  calculated width of number based on the string.
  107.           buffer += i2bin(len(ltrim(str(a_[i]))))
  108.           buffer += ltrim(str(a_[i]))
  109.  
  110.         otherwise
  111.           //  Type "A" for arrays will be handled
  112.           //  after we write the type.
  113.         endcase
  114.      endif
  115.  
  116.      //  Write the buffer, constructed above, to the file.
  117.      if fwrite(handle, buffer, len(buffer)) != len(buffer)
  118.         success := .f.
  119.         exit
  120.      endif
  121.  
  122.      /*
  123.         If this is a nested array, it's recursion time!
  124.  
  125.         Call ElementOut() again, it will append a series
  126.         of types/widths/values to the current file.
  127.      */
  128.      if left(buffer, 1) == "A"
  129.         ElementOut(handle, a_[i])
  130.      endif
  131.   next i
  132.  
  133. return success
  134.  
  135. // end of file CHP0916.PRG
  136.