Option Explicit
Public PlantList, PlantListWO As Variant
_____________________________________________________________________________________
Function ForagPath() As String
ForagPath = ReturnTopPath & "\ForagingPictures.com"
If Not FileExists(ForagPath) Then
MsgBox "Cannot proceed. The website folder was not found:" & vbLf & ForagPath, vbCritical, "Aborted!"
End
End If
End Function
_____________________________________________________________________________________
Private Sub BuildForagSitemap()
' is button on Dashboard sheet
CreateSiteMapFromOtherSheet ForagPath
End Sub
_____________________________________________________________________________________
Function ScientificName(ByRef PlantList As Variant, ByVal PIvalue As String) As String
' returns html string with plant's scientific name if it exists in PlantList
' also called in Pictures processing
Dim i As Integer
Dim t As String
' standard name
PIvalue = DropStr(PIvalue, 4)
' find row in PlantList
For i = 0 To UBound(PlantList)
If RemSciName(PlantList(i, 1)) = PIvalue Then
If 0 < InStr(PlantList(i, 1), "[") Then
t = DropStr(PlantList(i, 1), InStr(PlantList(i, 1), "["))
ScientificName = "
Scientific name: " & DropStr(t, -1)
Else
ScientificName = ""
End If
Exit Function
End If
Next i
ScientificName = ""
End Function
_____________________________________________________________________________________
Function PlantLink(ByRef PlantList As Variant, ByVal PIvalue As String) As String
' returns relative link to the plant's folder
Dim f As String
PIvalue = DropStr(PIvalue, 4)
If PIvalue = "" Then Exit Function
If FileExists(ForagPath & "\plants\" & Replace(PIvalue, " ", "_")) Then
' -> we should check here. if only one, then there should not be a link
PlantLink = "
More plant pictures at " & PIvalue & "" & vbCrLf
End If
End Function
_____________________________________________________________________________________
Function GetLocation(ByVal Name As String) As String
' gets location for a foraging album name. returns a short location name from the c_TourOrder.txt file
' also called in Pictures processing
' arg: album name in string
Dim i As Integer
Dim a As String
Dim C As Variant
a = Left(Name, 12)
C = GetFixedData(ForagPath & "\tours\data\c_TourOrder.txt", 13)
For i = 0 To UBound(C)
If C(i, 0) = a Then
GetLocation = C(i, 1)
Exit Function
End If
Next i
End Function
_____________________________________________________________________________________
Private Sub CombineFs()
' combines all plant names from all foraging albums
' creates: PlantData.txt and PlantDataNot.txt
Dim i As Integer, j As Integer
Dim f As String, t As String, resNot As String
Dim D, L, res, resSort As Variant
L = ListFiles(ForagPath & "\tours\data", "txt", , True, "pi_F-")
' loop for files
For i = 0 To UBound(L)
D = ReturnFileAsArrayOfRows(L(i))
' pure filename
f = RemoveExtension(ExtractFilename(L(i)))
f = DropStr(f, 3)
' loop for rows
For j = 0 To UBound(D)
t = f & " 0" & Left(D(j), 3) & " " & DropStr(D(j), 4)
' is it plant or not?
If Len(D(j)) > 4 Then
res = AppendVectors(res, t)
resSort = AppendVectors(resSort, DropStr(D(j), 4))
Else
resNot = resNot & t & vbCrLf
End If
Next j
Next i
' sort the found ones
res = IndexIntoVector(res, GradeUp(resSort))
SaveIfChanged ForagPath & "\site-processing\PlantData.txt", Ravel(res, vbCrLf)
SaveIfChanged ForagPath & "\site-processing\PlantDataNot.txt", resNot
End Sub
_____________________________________________________________________________________
Private Sub AddToPlantList()
' adds all foraging list to PlantData and returns new plants not in PlantList
Dim i As Integer, j As Integer
Dim S As String
Dim D, L, PlantList, res As Variant
' must run before this
CombineFs
' unique plants in source data
D = RemDupSameOrder(ReturnColumn(GetFixedData(ForagPath & "\site-processing\PlantData.txt", 13, 5), 2))
' our master list of plants
' -> can share L variable
PlantList = GetFixedData(ForagPath & "\site-processing\PlantList.txt", 3)
' user may have added, so we sort and save
PlantList = SortMatrix(PlantList, 1)
For i = 0 To UBound(PlantList)
S = S & TakeString(PlantList(i, 0), 3) & PlantList(i, 1) & vbCrLf
Next i
SaveIfChanged ForagPath & "\PlantList.txt", S
' get list of only plant names, as all that is used here
L = ReturnColumn(PlantList, 1)
' we check for duplicates
If UBound(L) <> UBound(RemDupSameOrder(L)) Then
MsgBox "Duplicates found in PlantList.txt: " & ReturnDups(L, True), vbCritical, "Aborted"
Exit Sub
End If
' remove scientific names
L = RemSciName(L)
' loop for data and see if member of list
For i = 0 To UBound(D)
If Not IsMember(L, D(i)) Then
res = AppendVectors(res, D(i))
End If
Next i
If IsEmpty(res) Then
MsgBox "No new plants found.", vbExclamation, "Done"
Else
L = ReadInFile(ForagPath & "\site-processing\PlantList.txt")
For i = 0 To UBound(res)
L = L & " " & res(i) & vbCrLf
Next i
SaveFile ForagPath & "\site-processing\PlantList.txt", L
MsgBox UBound(res) + 1 & " new plants found and added to PlantList.txt bottom. They need to be classified and scientific name added.", vbExclamation, "Done"
End If
End Sub
_____________________________________________________________________________________
Function RemSciName(Vec As Variant, Optional RetSciName As Boolean) As Variant
' input and output are array vectors or strings
' opt flag returns sci name instead of base (with no leading space)
Dim i As Integer, j As Integer
If IsArray(Vec) Then
For i = 0 To UBound(Vec)
j = InStr(Vec(i), "[")
If j <> 0 Then
If RetSciName Then
Vec(i) = DropStr(Vec(i), j - 1)
Else
Vec(i) = Left(Vec(i), j - 2)
End If
End If
Next i
RemSciName = Vec
Else
j = InStr(Vec, "[")
If j <> 0 Then
If RetSciName Then
RemSciName = DropStr(Vec, j - 1)
Else
RemSciName = Left(Vec, j - 2)
End If
Else
If RetSciName Then
RemSciName = ""
Else
RemSciName = Vec
End If
End If
End If
End Function
_____________________________________________________________________________________
Private Sub ProcessAllPlants()
' is button on Dashboard sheet
' builds menu section for ForagingPictures.com home page, and all plant indexes and htms
' also sorts PlantList.txt
Dim i As Integer, j As Integer, k As Integer, q As Integer
Dim f As String, FP As String, H As String, t As String, tBN As String, tWO As String, ToursPath As String
Dim PIs, PIsTot, PIsU, PlantData, PlantDataNames, PlantIndex, PlantListBN, PlantListMO, PlantListMOi As Variant
Dim Data, SortList, SubList, temp, TourOrder, UniqLocs As Variant
FP = ForagPath
ToursPath = FP & "\tours"
PlantIndex = GetFixedData(FP & "\site-processing\PlantIndex.txt", 3)
' our master list of the different plants
SortPlantList 1
PlantList = GetFixedData(FP & "\site-processing\PlantList.txt", 3)
' we check that there are no blanks left from additions
For i = 0 To UBound(PlantList)
If PlantList(i, 0) = "" Then
MsgBox "PlantList has blank in first column. Needs one of the six group codes.", vbCritical, "Aborted"
Exit Sub
End If
Next i
' convenient to have the plant names in two vectors
temp = ReturnColumn(PlantList, 1)
PlantListWO = RemSciName(temp)
PlantListBN = RemSciName(temp, True)
' we collect names in menu order, for slide show to follow
ReDim PlantListMO(UBound(PlantListWO))
ReDim PlantListMOi(UBound(PlantListWO))
' all picture entries, columns: 0-pi_ filename, 1-picture number, 2-plant name in plant index
PlantData = GetFixedData(FP & "\site-processing\PlantData.txt", 13, 5)
PlantDataNames = ReturnColumn(PlantData, 2)
' check for any plants not in PlantList
For i = 0 To UBound(PlantData)
If Not IsMember(PlantListWO, PlantData(i, 2)) Then
MsgBox "Plant: " & PlantData(i, 2) & " in PlantData was not found in PlantList.", vbCritical, "Aborted"
Exit Sub
End If
Next i
' check that plant in PlantList has some members in the data
For i = 0 To UBound(PlantListWO)
If Not IsMember(PlantDataNames, PlantListWO(i)) Then
MsgBox "Plant '" & PlantListWO(i) & "' found in PlantList has no members in the PlantData. You need to rerun Add to PlantList.", vbCritical, "Aborted"
Exit Sub
End If
Next i
' get tour location list and save locations only in alpha order. cols: 0-tour folder name, 1-location
TourOrder = SortMatrix(GetFixedData(ToursPath & "\data\c_TourOrder.txt", 13), 1)
' ~~~~~~ home page index files ~~~~~~
' table of contents
H = "
" & vbCrLf & vbCrLf Next i ' in season order InsertIntoHtm FP & "\tours\index.htm", Ravel(temp) & vbCrLf ' we append the locations as the first column of a matrix to make alpha sorting easier Data = Catenate1dot5(ReturnColumn(SubList, 1), temp) ' in alpha order InsertIntoHtm FP & "\tours\index-alpha.htm", Ravel(ReturnColumn(SortMatrix(Data, 0), 1)) & vbCrLf ' we append the filenames as the first column of a matrix to make date sorting easier temp = Catenate1dot5(ReturnColumn(SubList, 0), temp) ' in descending date order InsertIntoHtm FP & "\tours\index-desc-date.htm", Ravel(ReturnColumn(SortMatrix(temp, 0, , True), 1)) & vbCrLf ' in ascending date order InsertIntoHtm FP & "\tours\index-asc-date.htm", Ravel(ReturnColumn(SortMatrix(temp, 0), 1)) & vbCrLf ' ~~~~~~ build location table ~~~~~~ ' find unique locations UniqLocs = RemDupSameOrder(ReturnColumn(TourOrder, 1)) ' we get all tour plant lists upfront for efficiency ReDim PIs(UBound(TourOrder)) For i = 0 To UBound(TourOrder) PIs(i) = ReturnColumn(GetFixedData(ToursPath & "\data\pi_" & TourOrder(i, 0) & ".txt", 4), 1) ' also all in list for counting PIsTot = AppendVectors(PIsTot, PIs(i)) Next i ' and in a nest of plant lists by unique locations ReDim PIsU(UBound(UniqLocs)) For i = 0 To UBound(PIsU) For j = 0 To UBound(TourOrder) If TourOrder(j, 1) = UniqLocs(i) Then PIsU(i) = AppendVectors(PIsU(i), PIs(j)) End If Next j Next i ' build table heading H = "