home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / ARRAYS.PRG < prev    next >
Encoding:
Text File  |  1991-04-23  |  6.7 KB  |  222 lines
  1. /*
  2.     GSAVEARRAY() and GLOADARRAY()
  3.     Functions to save and load arrays from/to text files
  4.     Copyright (c) 1990 Greg Lief - All Rights Reserved
  5.     Special Thanks to Craig Yellick for his contributions!
  6.     Clipper 5.x Version
  7.     Compile instructions: clipper arrays /n/w/a
  8. */
  9.  
  10. /* Stub program to test these functions */
  11.  
  12. #ifdef TESTING
  13.  
  14. function Main()
  15. local myarray
  16. local a := { 'one', 'two', 'three', NIL, ;
  17.            { 'this', 'is a', {'another', 'test', {1,2,3} } }, ;
  18.            { || "BLOCK TEST" }, .t., directory("*.EXE") }
  19. gsavearray(a, 'temp.txt')
  20. wait "Array saved to TEMP.TXT... press a key to continue."
  21. if len( myarray := gloadArray('temp.txt') ) > 0
  22.    cls
  23.    DumpArray(myarray)
  24. endif
  25. return nil
  26.  
  27. function DumpArray(a_, level)
  28. /*
  29.    List the contents of any array. Listing is indented to show nesting
  30.    of subarrays. This function uses a recursive call to itself. Do not
  31.    specify the level parameter, it is used internally during the
  32.    recursive calls.
  33. */
  34. local i
  35. if level = nil
  36.    level := 0
  37. endif
  38. for i := 1 to len(a_)
  39.    ? space(level * 4) + str(i, 4) + ": "
  40.    if valtype(a_[i]) = "A"
  41.       ?? "{..}"
  42.       DumpArray(a_[i], level + 1)
  43.    else
  44.       ?? a_[i]
  45.    endif
  46. next i
  47. return nil
  48.  
  49. #endif
  50.  
  51. * end main stub program
  52. *--------------------------------------------------------------------*
  53.  
  54. /*
  55.       Function: GLoadArray()
  56.       Copyright (c) 1990 Greg Lief - All Rights Reserved
  57.       Purpose: load an array from a previously saved text file
  58.       Syntax: LoadArray(<filename>)
  59.       Parameters:  <filename> is the name of the file from which to
  60.                    load the array.
  61.  
  62.       Return Value:  The target array.  If the load failed, the
  63.                      target array will have a length of zero.
  64.  
  65.       Sample call: myarray := LoadArray('array.txt')
  66.  
  67. */
  68. function GLoadArray(fileName)
  69. local nHandle, aArray := {}
  70. if (nHandle := fopen(fileName)) != -1
  71.    ElementIn(nHandle, aArray)
  72. endif
  73. fclose(nHandle)
  74. return aArray
  75.  
  76. * end function GLoadArray()
  77. *--------------------------------------------------------------------*
  78.  
  79. /*
  80.    Function: ElementIn()
  81.    Copyright (c) 1990 Greg Lief - All Rights Reserved
  82.    (Converted to use L-string style element storage by Craig Yellick.)
  83.    Purpose: actually reads each element of the array
  84.    Internal Only!!
  85. */
  86. static function ElementIn(handle, a_)
  87. local buffer, i, cnt, iLen, iType := ' '
  88. //─────  Read the overall array size
  89. buffer := space(2)
  90. if fread(handle, @buffer, 2) = 2
  91.    //─────  Process each array element stored in the file.
  92.    cnt := bin2i(buffer)
  93.    for i = 1 to cnt 
  94.       //─────  Read the element's data type.
  95.       //─────  If element is a nested array-- recursion time!
  96.       fread(handle, @iType, 1)
  97.       if iType == "A"
  98.          aadd(a_, {})
  99.          ElementIn( handle, a_[ len(a_) ] )
  100.       else
  101.          //─────  Read the length of the element.
  102.          buffer := space(2)
  103.          if fread(handle, @buffer, 2) = 2
  104.             iLen := bin2i(buffer)
  105.  
  106.             //─────  Read the actual element.
  107.             buffer := space(iLen)
  108.             if fread(handle, @buffer, iLen) = iLen
  109.  
  110.                //─────  Convert from string to specified data type.
  111.                do case
  112.                 /*
  113.                    Note that this will simply not work with code blocks.
  114.                    If you attempted to save one from an array, we will have
  115.                    empty space and thus must add a NIL to serve only as a
  116.                    placeholder.
  117.                 */
  118.                   case (iType = "B") .or. (iType = "Z")
  119.                      aadd(a_, nil)
  120.                   case iType = "C"
  121.                      aadd(a_, buffer)
  122.                   case iType = "D"
  123.                      aadd(a_, ctod(buffer))
  124.                   case iType = "L"
  125.                      aadd(a_, (buffer == "T"))
  126.                   case iType = "N"
  127.                      aadd(a_, val(buffer))
  128.                endcase
  129.             endif
  130.          endif
  131.       endif
  132.    next i
  133. endif
  134. return nil
  135.  
  136. * end static function ElementIn()
  137. *--------------------------------------------------------------------*
  138.  
  139.  
  140. /*
  141.    Function: GSaveArray()
  142.    Copyright (c) 1990 Greg Lief - All Rights Reserved
  143.    Purpose:     saves a specified array to a text file.
  144.    Syntax:      SaveArray(<array>, <filename>)
  145.    Parameters:  <array> is the name of the array to be saved.
  146.                 Do not enclose this in quotes!
  147.  
  148.                 <filename> is the name of the file in which to
  149.                 save the array.  Note that if this file exists,
  150.                 it will be overwritten!
  151.  
  152.    Returns:     A logical True (.T.) if the save was successful;
  153.                 False (.F.) if it was not.
  154.  
  155.    Example:     savearray(marray, 'array.txt')
  156. */
  157. function gsavearray(a_, fileName)
  158. local cnt := len(a_), handle := fcreate(fileName), success := .f.
  159. if handle != -1
  160.    success := ElementOut(handle, a_)
  161.    fclose(handle)
  162. endif
  163. return success
  164.  
  165. * end function GSaveArray()
  166. *--------------------------------------------------------------------*
  167.  
  168. /*
  169.    Function: ElementOut()
  170.    Copyright (c) 1990 Greg Lief - All Rights Reserved
  171.    (Converted to use L-string style element storage by Craig Yellick.)
  172.    Purpose: actually writes each element of the array
  173.    Internal Only!!
  174. */
  175. static function ElementOut(handle, a_)
  176. local cnt := len(a_), i, buffer, success := .t.
  177. //─────  Write the overall array size.
  178. fwrite(handle, i2bin(cnt))
  179.  
  180. //─────  Process each element in the array.
  181. for i = 1 to cnt
  182.  
  183.    //─────  Special handling for the NIL and code block data types
  184.    if (a_[i] = nil) .or. (valtype(a_[i]) = "B")
  185.       buffer := "Z" +i2bin(1) +"Z"
  186.    else
  187.       /*
  188.          Each element is encoded as follows.
  189.             Type:  C,D,L,N
  190.            Width:  Number of characters needed to store value
  191.            Value:  String version of the value.
  192.       */
  193.       buffer := valtype(a_[i])
  194.       do case
  195.          case buffer = "C"
  196.             buffer += i2bin(len(a_[i])) +a_[i]
  197.          case buffer = "D"
  198.             buffer += i2bin(8) +dtoc(a_[i])
  199.          case buffer = "L"
  200.             buffer += i2bin(1) +if(a_[i], "T", "F")
  201.          case buffer = "N"
  202.             buffer += i2bin(len(str(a_[i]))) + str(a_[i])
  203.          otherwise
  204.             //───── Type "A" for arrays will be handled after we write the type
  205.       endcase
  206.    endif
  207.    if fwrite(handle, buffer, len(buffer)) != len(buffer)
  208.       success := .f.
  209.       exit
  210.    endif
  211.    //───── if this is a nested array, recursion time!
  212.    if left(buffer, 1) == "A"
  213.       ElementOut( handle, a_[i] )
  214.    endif
  215. next i
  216. return success
  217.  
  218. * end static function ElementOut()
  219. *--------------------------------------------------------------------*
  220.  
  221. * end of file ARRAYS.PRG
  222.