home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NANNWS35.ARC / ASR.PRG next >
Encoding:
Text File  |  1989-03-01  |  4.1 KB  |  174 lines
  1. * Program: ASR.prg
  2. * Author:  David Morgan
  3. * Version: Clipper Summer '87
  4. * Note(s): Array Save and Restore user-defined
  5. *          functions.
  6. *
  7. * Copyright (c) 1989 Nantucket Corp.
  8.  
  9. CLEAR
  10. DECLARE the_arrays[3]
  11. DECLARE current_events[5], literature[4]
  12. DECLARE math[6]
  13. the_arrays[1] = 'current_events'
  14. the_arrays[2] = 'literature'
  15. the_arrays[3] = 'math'
  16. current_events[1] = 'Seoul'
  17. current_events[2] = .F.
  18. current_events[3] = ctod('11/08/88')
  19. current_events[5] = 'World Series'
  20. literature[1] = 'Because I do not hope to'+;
  21.                 ' turn again '+ ;
  22.                 'Consequently I rejoice,' +;
  23.                 ' having to construct'+ ;
  24.                 ' something Upon which to' +;
  25.                 ' rejoice.'
  26. literature[3] = 'As for man, his days are' + ;
  27.                 ' as grass: as a flower of'+ ;
  28.                 ' the field, so he' + ;
  29.                 ' flourisheth.  For the' + ;
  30.                 ' wind passeth over it, and'+;
  31.                 ' it is gone' + ;
  32.                 ' and the place thereof' + ;
  33.                 ' shall know it no more.'
  34. literature[4] = 'Nor I, nor any man that' + ;
  35.                 ' but man is, with nothing' +;
  36.                 ' shall be pleased till he '+;
  37.                 'be eased with being nothing.'
  38. math[1] = 3.14159
  39. math[2] = 'trigonometry'
  40. math[3] = 2.71828
  41. math[4] = .T.
  42. math[6] = 'approximation series'
  43.  
  44. Asave("the_arrays")
  45. RELEASE current_events, literature, math
  46. Arestore("the_arrays")
  47.  
  48.  
  49. FUNCTION Asave
  50. PARAMETERS filename
  51. PRIVATE buffer, hndl, i, single_element,;
  52.    upper_bound
  53. buffer = ''
  54. BEGIN SEQUENCE
  55.    IF FILE(filename+'.ARR')
  56.       hndl = FOPEN(filename+'.ARR',2)
  57.    ELSE
  58.       hndl = FCREATE(filename+'.ARR',0)
  59.    ENDIF
  60.    is_f_ok()
  61.    FWRITE(hndl, buffer, 0)
  62.    is_f_ok()
  63.    single_element = &filename.[1]
  64.    IF TYPE(single_element) = 'A'
  65.       upper_bound = LEN(&filename.)
  66.       FOR i = 1 to upper_bound
  67.          single_element = &filename.[i]
  68.          IF TYPE(single_element) # 'A'
  69.             BREAK
  70.          ENDIF
  71.          DO save_1_array WITH single_element
  72.       NEXT
  73.    ELSE
  74.       DO save_1_array WITH filename
  75.    ENDIF
  76.    FCLOSE(hndl)
  77.    RETURN .T.
  78. END SEQUENCE
  79. FCLOSE(hndl)
  80. ERASE (filename+'.ARR') 
  81. RETURN .F.
  82.  
  83.  
  84. PROCEDURE save_1_array
  85. PARAMETERS array
  86. PRIVATE i, numstr, element, length, record
  87. length = LEN(&array.)
  88. record = 'A' + SUBSTR(array+SPACE(10),1,10) +;
  89.   STR(length,4,0)
  90. FWRITE(hndl, record)
  91. FOR i = 1 TO length
  92.    record = TYPE('&array.[i]')
  93.    element = IIF(record#'U', &array.[i], '')
  94.    DO CASE
  95.    CASE record = 'C'
  96.       record = record +STR(LEN(element),5,0)+;
  97.          element
  98.    CASE record = 'N'
  99.       numstr = LTRIM(TRIM(STR(element)))
  100.       record = record + I2BIN(LEN(numstr)) + ;
  101.          numstr
  102.    CASE record = 'L'
  103.       record = record + IIF(element, 'T', 'F')
  104.    CASE record = 'D'
  105.        record = record + DTOC(element)
  106.    END
  107.    FWRITE(hndl,record)
  108.    is_f_ok()
  109. NEXT
  110. RETURN
  111.  
  112.  
  113. FUNCTION Arestore
  114. PARAMETERS filename
  115. PRIVATE hndl
  116. BEGIN SEQUENCE
  117.    hndl = FOPEN(filename+'.ARR',0)
  118.    is_f_ok()
  119.    DO WHILE FREADSTR(hndl,1)= 'A'
  120.       DO rest_1_array
  121.    ENDDO
  122.    FCLOSE(hndl)
  123.    RETURN .T.
  124. END SEQUENCE
  125. FCLOSE(hndl)
  126. RETURN .F.
  127.  
  128.  
  129. PROCEDURE rest_1_array
  130. PRIVATE aname, arecord, element, length, ;
  131.    no_elements, typ
  132. arecord = FREADSTR(hndl,14)
  133. is_f_ok()
  134. aname = TRIM(SUBSTR(arecord,1,10))
  135. no_elements = VAL(SUBSTR(arecord,11,4))
  136. RELEASE &aname.
  137. PUBLIC &aname.[no_elements]
  138. FOR element = 1 TO no_elements
  139.    typ = FREADSTR(hndl,1)
  140.    is_f_ok()
  141.    DO CASE
  142.    CASE typ = 'C'
  143.       length = VAL(FREADSTR(hndl,5))
  144.       is_f_ok()
  145.       &aname.[element] = FREADSTR(hndl,length)
  146.    CASE typ = 'N'
  147.       length = BIN2I(FREADSTR(hndl,2))
  148.       is_f_ok()
  149.       &aname.[element] = VAL(FREADSTR(hndl,;
  150.          length))
  151.    CASE typ = 'L'
  152.       length = 1
  153.       &aname.[element] = (FREADSTR(hndl,;
  154.          length) = 'T')
  155.    CASE typ = 'D'
  156.       length = 8
  157.       &aname.[element] = CTOD(FREADSTR(hndl,;
  158.          length))
  159.    CASE typ = 'U'
  160.    OTHERWISE
  161.       RELEASE &aname.
  162.    BREAK
  163.    END
  164.    is_f_ok()
  165. NEXT
  166. RETURN
  167.  
  168.  
  169. FUNCTION is_f_ok
  170. IF FERROR() > 0
  171.    BREAK
  172. ENDIF
  173. RETURN ''
  174.