' MacroName: Cutter
' MacroDescription: Given an input name, returns the Cutter number
' Written by: Joel Hahn, Niles Public Library District

'Note: This macro will not run without datafiles consisting of 
'the relevant cutter tables.  It is currently set to look for 
'these files in the directory c:\cutter\ on your hard drive.  
'There must be one file for each letter of the alphabet, and the 
'data must be arranged in the format "Abbb;111[CR/LF]Accc;112...", 
'where Abbb is some name fragment, 111 is the associated number, 
'and [CR/LF] is a carriage return/line feed combination.

Declare Function Cutter(a$) as String
Declare Function BinaryCutter(a$) as String

sub main
On Error Goto done1

' Set up input window, get input
Begin Dialog CName 100, 54, "AutoCutter"
   Text  5, 2, 87, 8, "Enter text to be Cuttered:"
   TextBox  5, 13, 90, 11, .Name
   OkButton  5, 30, 40, 20
   CancelButton  55, 30, 40, 20
End Dialog
dim NChoice as CName
dialog NChoice

a$=Trim(NChoice.Name)

If a$="" Then Goto done2
Cutt=Cutter(a$)
msgbox cutt, , "AutoCutter"

done1:
Resume done2
done2:
end sub

Function Cutter(a$)

a$=left(a$, 20)
if (instr(a$, chr(44))) then 
  place=instr(a$, chr(44))
  l$=Left(a$, place-1)
  r$=Right(a$, (Len(a$)-(place)))
  a$=l$+r$
end if

if left(a$, 2)="Mc" then
 l$="M"
 r$=Right(a$, (Len(a$)-1))
 a$=l$+"a"+r$
end if

chars=0 : g=1
do while g<=LEN(a$)
 if (asc(mid(a$, g, 1))>32 and asc(mid(a$, g, 1))<65) or (asc(mid(a$, g, 1))>90 and asc(mid(a$, g, 1))<97) or (asc(mid(a$, g, 1))>122) then
   place=g
   l$=Left(a$, place-1)
   r$=Right(a$, (Len(a$)-(place)))
 select case asc(mid(a$, g, 1))
 case 38
   a$=l$+"and"+r$
 case 37
   a$=l$+" percent"+r$
 case 48
   a$=l$+"zero"+r$
 case 49
   a$=l$+"one"+r$
 case 50
   a$=l$+"two"+r$
 case 51
   a$=l$+"three"+r$
 case 52
   a$=l$+"four"+r$
 case 53
   a$=l$+"five"+r$
 case 54
   a$=l$+"six"+r$
 case 55
   a$=l$+"seven"+r$
 case 56
   a$=l$+"eight"+r$
 case 57
   a$=l$+"nine"+r$
 case 64
   a$=l$+"a"+r$
 case 91 to 96
   a$=l$+r$
 case 161
   a$=l$+"L"+r$
 case 162
   a$=l$+"O"+r$
 case 165
   a$=l$+"Ae"+r$
 case 166
   a$=l$+"Oe"+r$
 case 172
   a$=l$+"O"+r$
 case 173
   a$=l$+"U"+r$
 case 177
   a$=l$+"l"+r$
 case 178
   a$=l$+"o"+r$
 case 181
   a$=l$+"ae"+r$
 case 182
   a$=l$+"oe"+r$
 case 188
   a$=l$+"o"+r$
 case 189
   a$=l$+"u"+r$
 case else
   a$=l$+r$
 end select
 end if
 g=g+1
 chars=0
Loop

' Open the relevant data file, dump all the data into the LINES array
filenumber%=Freefile
filename$="c:\cutter\"+left(a$, 1)+".dat"
Open filename$ for Input As filenumber%
   newline=Chr(10)
   x=1 : cuttdat$="Aa;111" : TrialCutName$="" : TrialCutNum$=""
   Do Until x=Lof(filenumber%)
      CutName$=GetField(cuttdat$, 1, ";")
      CutNum$=GetField(cuttdat$, 2, ";")
      OldTrialCutName$=TrialCutName$
      OldTrialCutNum$=TrialCutNum$
      Line Input #filenumber%, cuttdat$
      TrialCutName$=GetField(cuttdat$, 1, ";")
      TrialCutNum$=GetField(cuttdat$, 2, ";")
      t1$=lcase(left(a$,len(TrialCutName$))) : t2$=lcase(TrialCutName$)
      if t1$<t2$ then
        retval=CutNum$
        Exit Do
      end if
      x=x+1
      y=Seek(filenumber%)
      If y>Lof(filenumber%) then
         x=Lof(filenumber%)
      Else
         Seek filenumber%,y
      End If
      'msgtext=msgtext & cuttdat$ & newline
   Loop
      if x=Lof(filenumber%) and t1$>t2$ then
        retval=TrialCutNum$
        OldTrialCutName$=TrialCutName$
        OldTrialCutNum$=TrialCutNum$
      end if

Close filenumber%

PrevCutt$=OldTrialCutName$+"   "+OldTrialCutNum$
NextCutt$=TrialCutName$+"   "+TrialCutNum$
If retval="" Then
  NewCutter$=UCase(left(a$, 1))+TrialCutNum$
Else
  NewCutter$=UCase(left(a$, 1))+retval
End If

Cutter$=NewCutter$+Chr(10)+Chr(10)+"  "+PrevCutt$+Chr(10)+a$+Chr(10)+"  "+NextCutt$

End Function

Function BinaryCutter(a$)
'Uses a binary search rather than a brute force approach

Dim j(12334) As String : Dim k(12334) As String
'12334 allows for using a single datafile
Dim Min as Long
Dim Max as Long
Dim Middle as Long
  'During the search, the target's index will always be 
  'between Min & Max-- Min <= target index <= Max

a$=left(a$, 20)
if (instr(a$, chr(44))) then 
  place=instr(a$, chr(44))
  l$=Left(a$, place-1)
  r$=Right(a$, (Len(a$)-(place)))
  a$=l$+r$
end if

if left(a$, 2)="Mc" then
 l$="M"
 r$=Right(a$, (Len(a$)-1))
 a$=l$+"a"+r$
end if

chars=0 : g=1
do while g<=LEN(a$)
 if (asc(mid(a$, g, 1))>32 and asc(mid(a$, g, 1))<65) or (asc(mid(a$, g, 1))>90 and asc(mid(a$, g, 1))<97) or (asc(mid(a$, g, 1))>122) then
   place=g
   l$=Left(a$, place-1)
   r$=Right(a$, (Len(a$)-(place)))
 select case asc(mid(a$, g, 1))
 case 38
   a$=l$+"and"+r$
 case 37
   a$=l$+" percent"+r$
 case 48
   a$=l$+"zero"+r$
 case 49
   a$=l$+"one"+r$
 case 50
   a$=l$+"two"+r$
 case 51
   a$=l$+"three"+r$
 case 52
   a$=l$+"four"+r$
 case 53
   a$=l$+"five"+r$
 case 54
   a$=l$+"six"+r$
 case 55
   a$=l$+"seven"+r$
 case 56
   a$=l$+"eight"+r$
 case 57
   a$=l$+"nine"+r$
 case 64
   a$=l$+"a"+r$
 case 91 to 96
   a$=l$+r$
 case 161
   a$=l$+"L"+r$
 case 162
   a$=l$+"O"+r$
 case 165
   a$=l$+"Ae"+r$
 case 166
   a$=l$+"Oe"+r$
 case 172
   a$=l$+"O"+r$
 case 173
   a$=l$+"U"+r$
 case 177
   a$=l$+"l"+r$
 case 178
   a$=l$+"o"+r$
 case 181
   a$=l$+"ae"+r$
 case 182
   a$=l$+"oe"+r$
 case 188
   a$=l$+"o"+r$
 case 189
   a$=l$+"u"+r$
 case else
   a$=l$+r$
 end select
 end if
 g=g+1
 chars=0
Loop

filenumber%=Freefile
filename$="c:\cutter\"+left(a$, 1)+".dat"
'filename$="c:\cutter\cutter.dat"
Open filename$ for Input As filenumber%
   x=1 : z=0 : cuttdat$="Aa;111" : TrialCutName$="" : TrialCutNum$=""
   Do Until x=Lof(filenumber%)
      Line Input #filenumber%, cuttdat$
      j(x)=GetField(cuttdat$, 1, ";")
      k(x)=GetField(cuttdat$, 2, ";")
      x=x+1 : z=z+1
      y=Seek(filenumber%)
      If y>Lof(filenumber%) then
         x=Lof(filenumber%)
      Else
         Seek filenumber%,y
      End If
   Loop
Close filenumber%

Min=1
Max=z '729 '***total number of items
Do While Min<=Max
  Middle=(Max+Min)/2
  'MsgBox "/" & k(Middle) & "//" & j(Middle) & "/" & a$ & "/"
  'MsgBox "/" & a$ & "/" & j(Middle) & "/" & Min & "/" & Middle & "/" & Max
'found it exactly
  If lcase(a$)=lcase(j(Middle)) Then
    'MsgBox Min & "/" & Middle & "/" & Max
    Cutt=Middle
    Cuttr$=UCase(Left(a$, 1))+k(Cutt)
    PrevCutt$=j(Cutt)+"   "+k(Cutt)
    NextCutt$=j(Cutt+1)+"   "+k(Cutt+1)
    BinaryCutter$=Cuttr$+Chr(10)+Chr(10)+"  "+PrevCutt$+Chr(10)+a$+Chr(10)+"  "+NextCutt$
    Exit Function
'found it between, and Middle=Min or Min=Middle=Max
  ElseIf (lcase(a$)>lcase(j(Middle)) and (Max=Min+1 or Max=Min)) Then
    'MsgBox Min & "/" & Middle & "/" & Max
    Cutt=Min 'Middle
    Do Until lcase(a$)>lcase(j(Cutt)) and lcase(a$)<lcase(J(Cutt+1))
      Cutt=Cutt+1
    Loop
    Cuttr$=UCase(Left(a$, 1))+k(Cutt)
    PrevCutt$=j(Cutt)+"   "+k(Cutt)
    NextCutt$=j(Cutt+1)+"   "+k(Cutt+1)
    BinaryCutter$=Cuttr$+Chr(10)+Chr(10)+"  "+PrevCutt$+Chr(10)+a$+Chr(10)+"  "+NextCutt$
    Exit Function
'found it between, and Middle=Max
  ElseIf (lcase(a$)<lcase(j(Middle)) and Max=Min+1) Then
    'MsgBox Min & "/" & Middle & "/" & Max
    Cutt=Min-1
    Do Until lcase(a$)>lcase(j(Cutt)) and lcase(a$)<lcase(J(Cutt+1))
      Cutt=Cutt+1
    Loop
    Cuttr$=UCase(Left(a$, 1))+k(Cutt)
    PrevCutt$=j(Cutt)+"   "+k(Cutt)
    NextCutt$=j(Cutt+1)+"   "+k(Cutt+1)
    BinaryCutter$=Cuttr$+Chr(10)+Chr(10)+"  "+PrevCutt$+Chr(10)+a$+Chr(10)+"  "+NextCutt$
    Exit Function
'search left half of remaining items
  ElseIf lcase(a$)<lcase(j(Middle)) Then
    Max=Middle-1
'search right half of remaining items
  Else
    Min=Middle+1
  End If
Loop

'If we get here the target is not on the list
Cutt=z
Cuttr$=UCase(Left(a$, 1))+k(Cutt)
PrevCutt$=j(Cutt)+"   "+k(Cutt)
BinaryCutter$=Cuttr$+Chr(10)+Chr(10)+"  "+PrevCutt$

End Function