' ------------------------------------------------------------------------------------
'         			MakeAnaglyph.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.
' Three 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.
' 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, -10
' Note that the script can be VERY SLOW (vbscript is an interpreted language) on
' large pictures. It will take about 22 seconds for two 1024x768 pictures and 2'20
' for two 5 megapixel pictures (P4 @ 2.4 GHz).
' ------------------------------------------------------------------------------------

Option Explicit
const AnaRedGreen = 0	' B&W anaglyph using Red and Green glasses
const AnaRedBlue  = 1	' B&W anaglyph using Red and Blue glasses
const AnaColor    = 2	' Pseudo-color anaglyph using Red and Cyan glasses
const backColor = 0

Dim alb, pic, nbPic, i, k, iP, picL, picR, newPic, w, h, x, y, crL, crR, crNew, r, g, b, sNewFileName
Dim dx, dy, x0, y0, x2, y2, s
Dim nAnaType

nAnaType = AnaColor

app.ClearTrace
set alb = app.GetCurrentAlbum
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 & "..."
      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 dx & "  " & dy

      ' Compute the intersection of the left picture and offset right picture
      x0 = max( 0, dx )
      y0 = max( 0, dy )
      x2 = min( picL.w, dx + picR.w )-1
      y2 = min( picL.h, dy + picR.h )-1
      w = x2 - x0 + 1
      h = y2 - y0 + 1

	
'app.Trace "size= " & w & ", " & h
'app.Trace "p0= " & x0 & ", " & y0
'app.Trace "p2= " & x2 & ", " & y2
      ' Create a new empty picture
      set newPic = alb.NewPicture( w, h, 24, backColor )
      for x = x0 to x2
	for y = y0 to y2
	  ' Get the pixels from the two images
	  crL = picL.GetPixel( x, y )
	  crR = picR.GetPixel( x-dx, y-dy )
	  select case nAnaType
	    case AnaRedGreen
	      r = fix((30 * CInt( fix( crL / 65536 ) and &hff ) + 59 * CInt( fix( crL / 256 ) and &hff ) + 11 * CInt( crL and &hff )) / 100)
	      g = fix((30 * CInt( fix( crR / 65536 ) and &hff ) + 59 * CInt( fix( crR / 256 ) and &hff ) + 11 * CInt( crR and &hff )) / 100)
	      b = 0
	    case AnaRedBlue
	      r = fix((30 * CInt( fix( crL / 65536 ) and &hff ) + 59 * CInt( fix( crL / 256 ) and &hff ) + 11 * CInt( crL and &hff )) / 100)
	      g = 0
	      b = fix((30 * CInt( fix( crR / 65536 ) and &hff ) + 59 * CInt( fix( crR / 256 ) and &hff ) + 11 * CInt( crR and &hff )) / 100)
	    case AnaColor
	      r = CInt( fix( crL / 65536 ) and &hff )
	      g = CInt( fix( crR /   256 ) and &hff )
	      b = CInt( crR and &hff )
	  end select
	  crNew = b + g * 256 + r * 65536 
	  newPic.SetPixel x-x0, y-y0, crNew
	next
'app.Trace "x=" & x
      next

      ' Now save the anaglyphe picture using the name of the left picture and appending _A
      sNewFileName = alb.ExpandMacro( picL, "%RP" )
      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 )
      sNewFileName = sNewFileName & "_A.jpg"
      app.Trace " Saving anaglyph picture as '" & sNewFileName & "'...", -1, TRACE_INFORMATION
      newPic.copy 0

      alb.DeletePicture newPic
      set newPic = Nothing
      if alb.paste( sNewFileName ) then
	' Move the new picture just after the Right view
	set newPic = alb.GetPicture( alb.nbPicture - 1 )
	alb.MovePicture newPic, picR.num, True
	alb.nCurrentPicture = alb.CvtNumPic( newPic.num, False )
	'alb.DisplayPicture -1
	set newPic = Nothing
      else
	app.trace "Error: cannot load anaglyph picture '" & sNewFileName & "'", 255, TRACE_ERROR
      end if
      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

' ------------------------------------------------------------------------------------
function min( a, b )
  if a < b then
    min = a
  else
    min = b
  end if
end function

function max( a, b )
  if a > b then
    max = a
  else
    max = b
  end if
end function