' ------------------------------------------------------------------------------------
'         			MakeAnaglyph2.vbs
' This script will build anaglyph 3D pictures from a pair of left and right pictures.
' It will create an anaglyph for each of the selected pairs of pictures in the current
' album.
' The following types of anaglyph can be generated:
'	- B&W anaglyph to be used with Red and Green glasses,
'	- B&W anaglyph to be used with Red and Blue glasses,
'	- Pseudo-color anaglyph to be used with Red and Cyan glasses.
'	- Interlaced picture to be used with LCD shutter glasses.
' Change the value of the "nAnaType" variable to generate the wanted type.
' The right image can have an offset, specify it in Custom Field named Offset:
'	Example: Offset: 10,-15
' (meaning that the right picture should be shifted righ by 10 pixels and up by 15
' pixels).
' ------------------------------------------------------------------------------------

Option Explicit
const backColor = 0
const sAnaglyphTabName = "Anaglyphes"		' Keyword/Tab where the anaglyphs will be placed
const sOutputFileType = ".jpg"

Dim alb, pic, nbPic, i, iP, picL, picR, newPic, sNewFileName, x, k
Dim dx, dy, s, j, kwTab, kwTabAna
Dim nAnaType

' Use one of the following constants:
'  T3D_AnaRedGreen   	0   B&W anaglyph to be used with Red and Green glasses. 
'  T3D_AnaRedBlue   	1   B&W anaglyph to be used with Red and Blue glasses. 
'  T3D_AnaColor   	2   Pseudo-color anaglyph to be used with Red and Cyan glasses. 
'  T3D_InterlaceL   	3   Produce an interlaced image (left picture first) to be used with LCD glasses. 
'  T3D_InterlaceR	4   Produce an interlace image (right picture first) to be used with LCD glasses. 
'  T3D_AnaRedCyan	5   B&W anaglyph to be used with Red and Cyan glasses. 
'  T3D_AnaYellowBlue    6   Pseudo-color anaglyph to be used with Yellow and Blue glasses
'  T3D_AnaColor2        7   Same as T3D_AnaColor but red right channel is used for the green channel
'  T3D_InterlaceVL	8   Interlace images vertically (left first)
'  T3D_InterlaceVR	9   Interlace images vertically (right first)

nAnaType = 8 'T3D_InterlaceVL

app.ClearTrace
set alb = app.GetCurrentAlbum

  ' Create the keyword / tab that will receive the pictures
  if sAnaglyphTabName <> "" then
    set kwTabAna = alb.AddKeyword( sAnaglyphTabName )
    kwTabAna.bIsTab = True
  else
    set kwTabAna = Nothing
  end if

' The new picture will be added to the current tab
x = alb.nActiveTab
kwTab = -1
if x <> 0 then
  dim nK, nbK, kw
  nbK = alb.nbKeyword
  'app.Trace x & vbTab & alb.GetKeyword( x )
  for nK = 0 to nbK-1
    set kw = alb.GetKeyword( nK )
    'app.Trace nK & vbtab & kw.nKeyID & vbtab & alb.GetKeyword( nK )
    if kw.nKeyID = x then kwTab = nK
  next
  'app.Trace x & vbTab & alb.GetKeyword( kwTab )
end if

nbPic = alb.nbPicture

k = 0
iP = 0
i = 0
while i < nbPic + k
  Set pic = alb.GetPicture(i)
  if pic.bSelected then
    if iP = 0 then
      ' Wait to have a pair of pictures
      set picL = pic
      iP = 1
    else
      set picR = pic
      app.Trace "Processing left picture"  & vbTab & picL.sShortFileName & "...", -1, TRACE_INFORMATION
      app.Trace "Processing right picture" & vbTab & picR.sShortFileName & "..."
      iP = 0

      ' Retrieve the offset of the right picture
      dx = 0
      dy = 0
      s = picR.GetCustomField( "Offset" )
's = "-18,0"
      if s <> "" then
	Dim T
	T = Split( s, ",", -1, 1 )
	dx = CInt(T(0))
	dy = CInt(T(1))
      end if
      app.Trace "Offset of right picture = " & dx & ",  " & dy

      ' Create a new empty picture
      set newPic = alb.NewPicture( 1, 1, 24, backColor )
      if kwTab <> -1 then newPic.SetKeyword alb.GetKeyword( kwTab ), True
      newPic.MakeAnaglyph picL, picR, nAnaType, dx, dy

      ' Now save the anaglyphe picture using the name of the left picture and appending _A
      sNewFileName = alb.ExpandMacro( picL, "%RP" )
'app.Trace sNewFileName & vbTab & alb.ExpandMacro( Nothing, "%AP" )
      x = InStrRev( sNewFileName, "." )
      sNewFileName = left( sNewFileName, x-1 )

      ' I use to name my views _L and _R (or _left and _right, -L and -R)
      if LCAse(right( sNewFileName, 5 )) = "_left" then sNewFileName = left( sNewFileName, len(sNewFileName)-5 )
      if LCAse(right( sNewFileName, 2 )) = "_l" then sNewFileName = left( sNewFileName, len(sNewFileName)-2 )
      if LCAse(right( sNewFileName, 2 )) = "-l" then sNewFileName = left( sNewFileName, len(sNewFileName)-2 )
      if nAnaType = T3D_InterlaceL or nAnaType = T3D_InterlaceR then
        sNewFileName = sNewFileName & "_i" & sOutputFileType
      else
        sNewFileName = sNewFileName & "_A" & sOutputFileType
      end if
      app.Trace "Saving 3D picture as '" & sNewFileName & "'..."
      'newPic.copy 0

      if newPic.Save( sNewFileName, True ) then
        CopyInfo picL, newPic
        if not kwTabAna is Nothing then newPic.SetKeyword kwTabAna, True

        newPic.UpdateThumbnail True
        ' Move the new picture just after the Right view
        alb.MovePicture newPic, picR.num, True
        alb.nCurrentPicture = alb.CvtNumPic( newPic.num, False )
        'alb.DisplayPicture -1
        set newPic = Nothing
      else
	app.trace "Error: cannot save anaglyph picture '" & sNewFileName & "'", 255, TRACE_ERROR
      end if
      picL.Load False	' Free memory (or all the processed pictures will remain in memory)
      picR.Load False
      set picL = Nothing
      set picR = Nothing

      k = k + 1
    end if
  end if
  i = i+1
wend

alb.redraw
app.Trace "Done !!!", -1, TRACE_GREENDOT


' ------------------------------------------------------------------------------------
sub CopyInfo( byref picOrg, byref picDest )

  picDest.sComment = picOrg.sComment
  ' Get the keywords
  dim i, j, s, kw, kD, nbKW, tabKW()
  nbKW = alb.nbKeyword
  redim tabKW(nbKW)
  for i = 0 to nbKW-1
    set kw = alb.getKeyword(i)
    tabKW(i) = kw.sName
  next

  ' Get the custom fields
  dim nbCF, tabCF(), tabCFType()
  nbCF = alb.nbCustomField
  redim tabCF(nbCF), tabCFType(nbCF)
  for i = 0 to nbCF-1
    set kw = alb.getCustomField(i)
    tabCF(i) = kw.sName
    tabCFType(i) = kw.nType
  next

  ' Copy the keywords from the reference picture
  for j = 0 to nbKW-1
    set kw = alb.getKeyword(j)
    if picOrg.HasKeyword( kw.sName ) then picDest.SetKeyword kw.sName, True
  next

  ' Copy the custom fields from the reference picture
  for j = 0 to nbCF-1
    set kw = alb.getCustomField(j)
    if kw.nType <> CF_STRING then
      kD = picOrg.GetCustomFieldDate( kw.sName )
      if kD <> 0 then picDest.SetCustomFieldDate kw.sName, kD
    else
      s = picOrg.GetCustomField( kw.sName )
      if len(s) > 0 then 
      picDest.SetCustomField kw.sName, s
'app.Trace s & "  " & picDest.GetCustomField( kw.sName )
      end if
    end if
  next
end sub