home *** CD-ROM | disk | FTP | other *** search
/ Beter Homes & Gardens: Complete Guide to Gardening / GARDENS.BIN / gardens / pstdis / pstvarbl.bak < prev    next >
Text File  |  1994-04-01  |  4KB  |  201 lines
  1. SET exclusive off
  2. SET safety off
  3.  
  4. USE d:\grdncd\gardens\pstdis\pstdis.dbf EXCLUSIVE
  5.  
  6. * Alphabetize list
  7. SET ORDER TO TAG name
  8.  
  9. * Housekeeping
  10. goto top
  11. index = 1
  12. handle = 0
  13. savsection = section
  14. list = ""
  15.  
  16. * SET up file handle
  17. filename = "d:\grdncd\gardens\" + SUBSTR(section,1,3) + "\pstdis\" + "pstdis.var"
  18. IF FILE(filename)
  19.     ERASE filename
  20.     handle = FCREATE(filename)    && If not create it
  21. *    handle = FOPEN(filename,12)    && If so, open read/write
  22. ELSE
  23.     handle = FCREATE(filename)    && If not create it
  24. ENDIF
  25.  
  26. * Done for each record
  27. DO WHILE .NOT. EOF()
  28.  
  29.         IF section <> savsection
  30.  
  31.             * Output final list total
  32.             =FPUTS(handle,'@total')
  33.             =FPUTS(handle,ALLTRIM(STR(index-1)))
  34.             
  35.             * Output list string
  36.             =FPUTS(handle,'@list')
  37.             =FPUTS(handle,SUBSTR(list,1,LEN(list)-1))
  38.  
  39.             * Close previous file
  40.             =FCLOSE(handle)
  41.  
  42.             * SET up file handle
  43.             filename = "d:\grdncd\gardens\" + SUBSTR(section,1,3) + "\pstdis\" + "pstdis.var"
  44.             IF FILE(filename)
  45.                 ERASE filename
  46.                 handle = FCREATE(filename)    && If not create it
  47.             *    handle = FOPEN(filename,12)    && If so, open read/write
  48.             ELSE
  49.                 handle = FCREATE(filename)    && If not create it
  50.             ENDIF
  51.             
  52.             index = 1
  53.             savsection = section
  54.             list = ""
  55.         
  56.         ENDIF
  57.  
  58. * Output name
  59.         =FWRITE(handle,'@name[')
  60.         =FWRITE(handle,ALLTRIM(STR(index)))
  61.         =FPUTS(handle,']')
  62.         =FPUTS(handle,ALLTRIM(name))
  63.  
  64. * Output preview image name
  65.         =FWRITE(handle,'@image[')
  66.         =FWRITE(handle,ALLTRIM(STR(index)))
  67.         =FPUTS(handle,']')
  68.  
  69. * Get first image name
  70.         strptr = 1
  71.         DO WHILE strptr <= LEN(ALLTRIM(images))
  72.             IF SUBSTR(images,strptr,1) <> ";"
  73.                 =FWRITE(handle,SUBSTR(images,strptr,1))
  74.             ELSE
  75.                 EXIT
  76.             ENDIF
  77.             strptr = strptr + 1
  78.         ENDDO  
  79.         =FPUTS(handle,'')
  80.  
  81. * Output directory
  82.         =FWRITE(handle,'@dir[')
  83.         =FWRITE(handle,ALLTRIM(STR(index)))
  84.         =FPUTS(handle,']')
  85.         =FPUTS(handle,ALLTRIM(dir))  
  86.         
  87.         list = list + ALLTRIM(name) + ";"
  88.  
  89. * Increment and get next record
  90.     index = index + 1    && increment list index
  91.     SKIP    && get next record
  92.  
  93. enddo
  94.  
  95. * Output final list total
  96. =FPUTS(handle,'@total')
  97. =FPUTS(handle,ALLTRIM(STR(index-1)))
  98.  
  99. * Close file
  100. =FCLOSE(handle)
  101.  
  102.  
  103. * Rewind file to build species VAR files
  104. SET ORDER TO TAG dir
  105. GOTO TOP
  106. savname = name
  107. savimages = images
  108. savdir = dir
  109. savsect = section
  110. aka = ""
  111.  
  112. * Done for each record
  113. DO WHILE .NOT. EOF()
  114.     
  115. * Output VAR file at level break
  116.     IF dir <> savdir
  117.  
  118.     DO write_var        && write VAR file
  119.  
  120. * Garden Type specific data
  121.         savname = name
  122.         savimages = images
  123.         savdir = dir
  124.         savsect = section
  125.  
  126.     ELSE    && else of level break
  127.  
  128. * Build aka name
  129.         IF seq > "1"
  130.             aka = aka + ALLTRIM(name) + ";"
  131.         ENDIF
  132.  
  133.     ENDIF
  134.  
  135. * Get next record
  136.     SKIP    && get next record
  137.  
  138. ENDDO
  139.  
  140. DO write_var    && handle last record
  141.  
  142. *
  143. *    PROCEDURE write_var - Writes the VAR file
  144. *
  145.  
  146. PROCEDURE write_var
  147.  
  148. * set up file handle
  149.     filename = "d:\grdncd\gardens\" + SUBSTR(savsect,1,3) + "\pstdis\" + ALLTRIM(savdir) + "\" 
  150.     filename = filename + ALLTRIM(savdir) + ".var" 
  151.  
  152.     IF FILE(filename)    && if file exists, delete it
  153.         ERASE filename
  154.         handle = FCREATE(filename)    && If not create it
  155.     ELSE
  156.         handle = FCREATE(filename)    && If not create it
  157.     ENDIF
  158.  
  159. * Output name
  160.     =FPUTS(handle,'@name')
  161.     =FPUTS(handle,ALLTRIM(savname))
  162.  
  163. * Output aka name
  164.     =FPUTS(handle,'@aka')
  165.     IF LEN(aka) = 0        
  166.         =FPUTS(handle,'None')    && if no aka, put None
  167.     ELSE
  168.         =FPUTS(handle,substr(aka,1,len(aka)-1)) && if aka, lose last semicolon
  169.     ENDIF
  170.     aka = ""        && init to null
  171.  
  172. * Output images
  173.     index = 1
  174.     =FWRITE(handle,'@image[')
  175.     =FWRITE(handle,ALLTRIM(STR(index)))
  176.     =FPUTS(handle,']')
  177.  
  178. * Get first image name
  179.         strptr = 1
  180.         DO WHILE strptr <= LEN(ALLTRIM(savimages))
  181.             IF SUBSTR(savimages,strptr,1) <> ";"
  182.                 =FWRITE(handle,SUBSTR(savimages,strptr,1))
  183.             ELSE
  184.                 index = index + 1
  185.                 =FPUTS(handle,'')    && force CR to new image
  186.                 =FWRITE(handle,'@image[')
  187.                 =FWRITE(handle,ALLTRIM(STR(index)))
  188.                 =FPUTS(handle,']')
  189.             ENDIF
  190.             strptr = strptr + 1
  191.         ENDDO  
  192.         =FPUTS(handle,'')        && force last CR
  193.  
  194. * Output final image total
  195.         =FPUTS(handle,'@images')
  196.         =FPUTS(handle,ALLTRIM(STR(index)))
  197.  
  198. * Close file
  199.     =FCLOSE(handle)
  200.  
  201. RETURN