' MacroName: AutoCutter
' MacroDescription: Given an input name, returns the Cutter number

'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, though it is easy to
'change this to any other directory on the computer.  There must be one
'file for each letter of the alphabet for this macro to work as written
'(named a.dat, b.dat, c.dat, etc., though that's not difficult to change,
'either), and the data in each file must be arranged in the format
'Aa;111
'Abbb;112
'...
'Azz;999
'where Abbb & Abbc are names or name fragments, and 111 & 112 are the
'numbers associated with those names/fragments (a la the Cutter-Sanborn
'table, though any system that works along similar lines will work just as
'well).  The macro can handle "special" characters, such as ligatures,
'non-Latin characters and diacritics (by translating the ligatures
'into two characters, transliterating the non-Latin characters into English
'equivalents, and ignoring the diacritics) so one doesn't have to worry if a
'name to be checked includes these characters.

'Note: This macro does NOT check for uniqueness; it merely gives a
'standard result, exactly the same as looking up a name in a book of cutter
'tables.  As such, and depending on a library's particular practices, the
'results given by the macro my sufficient as is or they may merely serve
'as a handy starting point.

sub main

On Error Goto done1
dim j(729): dim k(729)

' Set up input window, get input
Begin Dialog CName 100, 54
   Caption "AutoCutter"
   Text 5, 2, 83, 11, "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$=NChoice.Name

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))>122 then
   place=g
   l$=Left(a$, place-1)
   r$=Right(a$, (Len(a$)-(place)))
 select case asc(mid(a$, g, 1))
 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)
   Do Until x=Lof(1)
      Line Input #filenumber, cuttdat$
      x=x+1
      y=Seek(1)
      If y>Lof(1) then
         x=Lof(1)
      Else
         Seek 1,y
      End If
      msgtext=msgtext & cuttdat$ & newline
   Loop
Close filenumber

fields=1 : total=729
Do While fields<=total
 GF$=GetField(msgtext, fields, chr(10))
 j(fields)=GetField(GF$, 1, ";")
 k(fields)=GetField(GF$, 2, ";")
 if j(fields)="" then
   total=fields-1
   Exit do
 end if
 fields=fields+1
Loop

count=1
do while count<=total
  t1$=lcase(left(a$,len(j(count)))) : t2$=lcase(j(count))
  if t1$<t2$ then
    cutt=k(count-1)
    exit do
  end if
  if count=total and t1$>t2$ then
    cutt=k(count)
    Exit do
  end if
  count=count+1
loop

cutt=ucase(left(a$, 1))+cutt
msgbox cutt, , "AutoCutter"

done1:
Resume done2
done2:
end sub