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