In which I confess to stupidity

In my previous post on sorting a scripture index, I used a rather lousy way of telling where the index was in the document. This came back to bite me today when I changed the number of references to a scripture index in a manuscript. In order to avoid this, use the following code instead. This is the complete macro file with the change made.

REM  *****  BASIC  *****
REM  *****  Sort Scripture Inde *****
REM  *****  Henry Neufeld, https://hneufeld.com *****
REM  *****  Feel free to use whatever of this code you find useful *****

'stuff is the workhorse array for this.  500 entries is arbitrary.  In the future I plan
'to have the routine redim if the array is too small.  For now 500 entries is quite adequate
Global stuff(500,6) as Variant '0 = paragraph text; 1=Object; 2=Page; 3=Passage
Const S_OBJ = 0  ' The TextElement Object
Const S_TEXT = 1  ' The actual text of the object; I swap the text between objects to sort
Const S_PAGE = 2  ' The page number from the line, used for the final sort
Const S_PASSAGE = 3 'used to detect identical entries so I can format duplicates
Const S_BOOK = 4 'S_BOOK, S_CHAPTER, and S_VERSE are used solely for sorting
Const S_CHAPTER = 5
Const S_VERSE = 6
Dim Bible() as String

Sub Main

End Sub

'Create the array of Bible books.  Modify this array to use different sort orders, add the apocrypha, and so forth
'This could be more efficient than a sequential search, but since I only use the routine a few times in the lifetime
'of any manuscript the difference in speed will be unimportant
Sub InitializeBible
	Bible = Array("Genesis", "Exodus", "Leviticus", "Numbers", "Deuteronomy", "Joshua", "Judges", "Ruth", "1 Samuel", "2 Samuel", "1 Kings", "2 Kings", _
					"1 Chronicles", "2 Chronicles", "Ezra", "Nehemiah", "Esther", "Job", "Psalm", "Proverbs", "Ecclesiastes", "Song of Solomon", _
					"Isaiah", "Jeremiah", "Lamentations", "Ezekiel", "Daniel", "Hosea", "Joel", "Amos", "Obadiah", "Jonah", "Micah", "Nahum", "Habakkuk", _
					"Zephaniah", "Haggai", "Zechariah", "Malachi", "Matthew", "Mark", "Luke", "John", "Acts", "Romans", "1 Corinthians", "2 Corinthians", _
					"Galatians", "Ephesians", "Philippians", "Colossians", "1 Thessalonians", "2 Thessalonians", "1 Timothy", "2 Timothy", "Titus", _
					"Philemon", "Hebrews", "James", "1 Peter", "2 Peter", "1 John", "2 John", "3 John", "Jude", "Revelation")
End Sub

'Sequentially searches the list of Bible books to conver the book into a number for sort purposes
Function BookNumber(bk as String) as Integer
	Dim i as Integer
	
	If bk = "" then
		BookNumber = 67
		Exit Function
	End If
	for i=0 to 65
		if Bible(i) = bk then Exit For
	next i
	BookNumber = i
End Function

'Splits the line of text into the elements of the "stuff" array
Sub SplitText(i as Integer)
	Dim txt,book,chap,verse as String
	dim c as Integer
	
	txt = stuff(i,S_TEXT)
	c = instr(txt,chr(9))
	'Alternatively the string will be empty or a completely invalid reference.
	If c > 0 Then
		stuff(i,S_PAGE) = Val(Mid(txt,c+1))
		txt = Left(txt,c-1)
		stuff(i,S_PASSAGE) = txt
	Else
		stuff(i,S_PAGE) = 0
	End If
	c = instr(3,txt," ")
	If c > 0 then
		book = Left(txt,c-1)
	Else
		book = ""
	End If
	txt = Mid(txt,c+1)
	stuff(i,S_BOOK) = BookNumber(book)
	c = instr(txt,":")
	if c > 0 then
		stuff(i,S_CHAPTER) = Val(Left(txt,c-1))
		txt = Mid(txt,c+1)
		c = instr(txt,"-")
		if c = 0 then c = instr(txt,"f")
		if c <> 0 then txt = left(txt,c-1)
		stuff(i,S_VERSE) = Val(txt)
	else
		stuff(i,S_CHAPTER) = Val(txt)
		stuff(i,S_VERSE) = 0
	end if
End Sub

'In sorting I swap everything but the TextElement object, then put the sorted strings into the unsorted
'TextElement objects to create the fully sorted list
Sub Swap(i as Integer,j as Integer)
	Dim temp(6)
	Dim k as Integer
	
	'code to swap two elements of stuff here
	for k = 1 to 6
		temp(k) = stuff(i,k)
	next k
	
	for k=1 to 6
		stuff(i,k) = stuff(j,k)
	next k

	for k = 1 to 6
		stuff(j,k) = temp(k)
	next k	
End Sub

'The main routine.  Run this from the Macros menu (or create whatever means of starting it you wish)
Sub Paragraphs
Dim Doc As Object
Dim Enum As Object
Dim TextElement As Object
Dim p, cnt, idx,k as Integer
Dim psg, txt as String

InitializeBible()
Doc = StarDesktop.CurrentComponent
Enum = Doc.Text.createEnumeration
p = 0
cnt = 0
idx = 0
While Enum.hasMoreElements
	TextElement = Enum.nextElement
	If TextElement.supportsService("com.sun.star.text.Paragraph") Then
		if p = 1 then
			cnt = cnt + 1
			stuff(idx,S_TEXT) = TextElement.String
			stuff(idx,S_OBJ) = TextElement
			SplitText(idx)
			idx = idx + 1	
		else
			'This is the major change.  Rather than counting instances of
			'Scripture Index I just look for the paragraph that is Scripture Index
			'and nothing else, and that is the title.  Sort everything after that.
			'Note that this still will not handle anything after the index.
			if TextElement.String = "Scripture Index" Then p = 1
		End If
	End If
Wend

k = idx - 1
'Sorts the list
QSort(0,k)

'Sets the sorted strings into the correct TextElements and blanks out the passage on multiple entries
'for the same passage
psg = ""
for p=0 to k
	If psg <> stuff(p,S_PASSAGE) Then
		psg = stuff(p,S_PASSAGE)
	Else
		txt = stuff(p,S_TEXT)
		txt = Mid(txt,InStr(txt,Chr(9)))
		stuff(p,S_TEXT) = txt
	End If
	stuff(p,S_OBJ).String = stuff(p,S_TEXT)
next p

MsgBox "Finished"
End Sub

'Comparison based on book number, then chapter, then verse, then the text of the passage reference
'which orders verses like Psalm 8:5-7 or 2 Timothy 3:16ff, then finally by the page number
Function Comp(i as Integer, j as Integer) as Integer
	if stuff(i,S_BOOK) <> stuff(j,S_BOOK) then
		Comp = stuff(i,S_BOOK) - stuff(j,S_BOOK)
		Exit Function
	End If
	if stuff(i,S_CHAPTER) <> stuff(j,S_CHAPTER) then
		Comp = stuff(i,S_CHAPTER) - stuff(j,S_CHAPTER)
		Exit Function
	End If
	If stuff(i,S_VERSE) <> stuff(j,S_VERSE) Then
		Comp = stuff(i,S_VERSE) - stuff(j,S_VERSE)
		Exit Function
	End If
	If stuff(i,S_PASSAGE) > stuff(j,S_PASSAGE) Then
		Comp = 1
		Exit Function
	ElseIf stuff(i,S_PASSAGE) < stuff(j,S_PASSAGE) Then
		Comp = -1
		Exit Function
	End If
	
	Comp = stuff(i,S_PAGE) - stuff(j,S_PAGE)
End Function

'I use a QSort just because I had one I'd written in C++ to convert.
Sub QSort(left as Integer, right as Integer)
	Dim i, last as Integer

	if left >= right Then Exit Sub

	Swap(left,(left+right)/2)
	last = left
	for i=left+1 to right
		if Comp(left,i) > 0 then
			last = last + 1
			Swap(last,i)
		end if
	next i
	Swap(left,last)
	QSort(left,last-1)
	QSort(last+1,right)
End Sub

This should still be regarded as alpha!