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