' ------------------------------------------------------------------------------------
'				RenameStereoPairs.vbs
' Rename all selected pictures as stereo pairs (assuming that the
' set of selected pictures contains, alternatively, left and right pictures).
' The user is asked for a base name and the pictures will be renamed as follow:
'	<basename><counter>_L.<ext>   and   <basename><counter>_R.<ext>
' ------------------------------------------------------------------------------------

Option Explicit

' Change the following constants to suit your needs:
const leftSuffix  = "_L"
const rightSuffix = "_R"
const nbDigits = 2
const startAt = 1

App.ClearTrace

Dim alb, pic, i, j, nb, baseName, cmpt, fso, nbRenamed
cmpt = startAt
set alb = App.GetCurrentAlbum
set fso = CreateObject("Scripting.FileSystemObject")

j = 0
nbRenamed = 0
nb = alb.nbSelectedPicture
if (nb and 1) = 0 then
  baseName = InputBox("Enter the base-name that will be used for renaming the pictures." & vbCrLf & "(or press Cancel to abort)", "RenameStereoPairs", "")
  if baseName <> "" then
  nb = alb.nbVisiblePicture
  for i = 0 to nb-1
    set pic = alb.GetVisiblePicture( i )
    if pic.bSelected then
        Dim oldFilename, oldExtension, pathname, newFilename, sFileName, file
        oldFilename = alb.ExpandMacro( pic, "%RP" )
        oldExtension = fso.GetExtensionName( oldFilename )
        pathname = fso.GetParentFolderName( oldFilename )
        newFilename = baseName
        sFileName = CStr( cmpt )
        while Len(sFileName) < nbDigits
          sFileName = "0" & sFileName
        wend
        newFilename = newFilename & sFileName
        if j and 1 then
          newFilename = newFilename & rightSuffix
        else
          newFilename = newFilename & leftSuffix
        end if
        newFilename = newFilename & "." & LCase( oldExtension )
        'App.trace oldFilename & " -> " & pathname & "\" & newFilename
	
        set file = fso.GetFile( oldFilename )
        on error resume next
          file.Name = newFilename
          if Err.Number<>0 then
            App.Trace "  " & oldFilename & " ->" & vbTab & newFilename & vbTab & vbTab & "Error: " & Err.Description
	    Err.clear
      	  else
	    pic.sFileName = pathname + "\" + newFilename
            App.trace oldFilename & " ->" & vbTab & newFilename & vbTab & "OK"
            nbRenamed = nbRenamed + 1
    	  end if
        on error goto 0

        ' Increment counter every two pictures
        if (j and 1) then cmpt = cmpt + 1
        j = j + 1
    end if
  next
  if nbRenamed > 0 then alb.Saved = False	' Set the album as modified
  alb.ReDraw
end if		' Aborted by user
else
  MsgBox "You must select a even number of pictures!", vbOKOnly, "RenameStereoPairs: Error"
end if		' Odd number of selected pictures
App.trace "Done !"