' ------------------------------------------------------------------------------------
'         			JoinPictures2.vbs
' This script will join two pictures by placing them side-by-side (either horizontally
' or vertically). It is assumed that the pictures are ordered in the album in a
' left/right, left/right,... manner.
' Joint pictures can be generated for parallel viewing, crossed viewing or over-under
' (ViewMagic style). Mirror effect can also be applied to the picture (for instance if
' a physical mirror is used for viewing the pictures).
' It will create a joint picture for each of the selected pairs of pictures in the
' current album.
' The right image can have an offset, specify it in a 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 sNewPicFileType = ".jpg"			' File type of the new pictures
const bHorizontalJoin = True			' Join pictures either horizontally or vertically
const bCrossedView = True			' Invert left/right pictures
const sJPicTabName = "JPS"			' Name of the keyword/tab that will receive the generated pictures
const bMirrorLeftPic = False			' Mirror the left picture
const bMirrorRightPic = False			' Mirror the right picture
const bUsePictureOffset = True			' Use the 'Offset' Custom field (to be set on the right picture)

' Resizing the pictures
const bResizePictures = True			' Resize pictures if thay are larger than maxW and/or maxH
const maxW = 1024				' Maximum width of one picture
const maxH =  768				' Maximum height of one picture
const bExactSize = True				' Picture will be centered on the maxW x maxH space
const backColor = &hff				' Filling color when pictures sizes don't match

const sStampInfo = "%C1 %C2"			' Information to print on the picture (set to "" to print no text)
const textColor = &hff00ff			' Text color of the comment
const textBkColor = -1				' Transparent background
const font ="Arial,120,0,400,0,0,0"

' Windows API constants
Const DT_CENTER = &H1		' Centers text horizontally.
Const DT_BOTTOM = &H8		' Specifies bottom-justified text.
Const DT_SINGLELINE = &H20	' Specifies single line only.
Const DT_NOPREFIX = &H800	' Turns off processing of prefix characters.

Dim alb, pic, nbPic, i, iP, pic1, pic2, newPic, picTMP, sNewFileName, x, k, kwTab, picOffset
Dim w, h, sOutputPath, dx, dy, x0, y0, x2, y2, w1, h1, w2, h2

app.ClearTrace
set alb = app.GetCurrentAlbum
if not alb is Nothing then
  if alb.nbSelectedPicture >= 2 then
    ' Using the album folder as the default output folder
    sOutputPath = alb.ExpandMacro( Nothing, "%Af" )
    sOutputPath = app.GetFilename( "Select the output folder (default is the album folder)", 2, sOutputPath, "", 0 )

    if sOutputPath <> "" then ProcessPictures
    alb.redraw
  else
    app.Trace "At least 2 pictures must be selected !", -1, TRACE_WARNING
  end if
else
  app.Trace "No album available !", -1, TRACE_WARNING
end if
app.Trace "Done !!!", -1, TRACE_OK


' ------------------------------------------------------------------------------------
function ProcessPictures

  ' Create the keyword / tab that will receive the joint pictures
  if sJPicTabName <> "" then
    set kwTab = alb.AddKeyword( sJPicTabName )
    kwTab.bIsTab = True
  else
    set kwTab = Nothing
  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 pic1 = pic
        iP = 1
      else
        if bCrossedView then
          set pic2 = pic1
          set pic1 = pic
        else
          set pic2 = pic
        end if
        set picOffset = pic
        app.Trace "Processing first picture "  & vbTab & vbTab & pic1.sShortFileName & "...", -1, TRACE_INFORMATION
        app.Trace "Processing second picture" & vbTab & pic2.sShortFileName & "..."
        iP = 0

        ' Compute the size of the new picture using the picture size, if applicable, the offset        
        if bUsePictureOffset then
          GetPictureOffset picOffset, dx, dy
          if bCrossedView then
            dx = -dx
            dy = -dy
          end if
        else
          dx = 0
          dy = 0
        end if
        ' Compute the intersection of the left picture and offset right picture
	x0 = max( 0, dx )
	y0 = max( 0, dy )
	x2 = min( pic1.w, dx + pic2.w )-1
	y2 = min( pic1.h, dy + pic2.h )-1
	w1 = x2 - x0 + 1
	h1 = y2 - y0 + 1
        
        ' Process left picture
        'PrintInfo pic1, pic1
        pic1.CopyRect x0, y0, x0+w1, y0+h1, 0
'app.trace "Left pic (" & x0 & ", " & y0 & ") - (" & x0+w1 & ", " & y0+h1 & ")"
        ResizePic bMirrorLeftPic

        ' Create a new empty picture
        if bHorizontalJoin then
          w = 2*w2
          h = h2
        else
          h = 2*h2
          w = w2
        end if
app.trace "New picture size is: " & w & ", " & h
        set newPic = alb.NewPicture( w, h, 24, backColor )
        CopyInfo pic1, newPic
        if not kwTab is Nothing then
          newPic.SetKeyword kwTab, True
        end if

        newpic.Paste 0, 0

        ' Process right picture
        'PrintInfo pic1, pic2
        pic2.CopyRect x0-dx, y0-dy, x0+w1-dx, y0+h1-dy, 0
app.trace "Right pic (" & x0-dx & ", " & y0-dy & ") - (" & x0+w1-dx & ", " & y0+h1-dy & ")"
        ResizePic bMirrorRightPic
        
        if bHorizontalJoin then
      	  newpic.Paste w2, 0
        else
	  newpic.Paste 0, h2
        end if

        ' Now save the new picture using the name of the left picture and appending _Z
        sNewFileName = sOutputPath & "\" & alb.ExpandMacro( pic1, "%BF" ) & "_z" & sNewPicFileType
        app.Trace " Saving new picture as '" & sNewFileName & "'...", -1, TRACE_ARROW

        if newPic.Save( sNewFileName, True ) then
          newPic.UpdateThumbnail True
          ' Move the new picture just after the second picture
          if bCrossedView then
            alb.MovePicture newPic, pic1.num, True
          else
            alb.MovePicture newPic, pic2.num, True
	  end if          
          alb.nCurrentPicture = alb.CvtNumPic( newPic.num, False )
          'alb.DisplayPicture -1
          set newPic = Nothing
        else
	  app.trace "Error: cannot save new picture '" & sNewFileName & "'", -1, TRACE_ERROR
        end if
        set pic1 = Nothing
        set pic2 = Nothing

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

' ------------------------------------------------------------------------------------
sub ResizePic( bMirrorPic )
  w2 = w1
  h2 = h1

  ' Apply mirror if needed (picture is on the Windows clipboard)
  if bMirrorPic then
    set picTmp = alb.NewPicture( w1, h1, 24, backColor )
    picTmp.Paste 0, 0
    picTmp.Mirror
    picTmp.Copy 0
    alb.DeletePicture picTmp
    set picTmp = Nothing
  end if

'app.trace " Should resize ?  w1=" & w1 & "   h1=" & h1
  if bResizePictures then 
    'if w1 >= maxW or h1 >= maxH then
      set picTmp = alb.NewPicture( w1, h1, 24, backColor )
      picTmp.Paste 0, 0
    
      w2 = maxW
      h2 = maxH
      Dim nResizeMode
      if bExactSize then
        nResizeMode = RM_EXACTSIZE
      else
        nResizeMode = RM_BOUNDINGRECT
      end if
      
      'if w1 > maxW then
	'w2 = maxW	
	'h2 = round( h1 * maxW / w1 )
      'else
	'w2 = round( w1 * maxH / h1 )
	'h2 = maxH
      'end if  
      picTmp.Resize w2, h2, nResizeMode, backColor, 0
      w2 = picTmp.w
      h2 = picTmp.h
      app.trace "Resizing picture " & w1 & "x" & h1 & " ---> " & w2 & "x" & h2
      picTmp.Copy 0
      alb.DeletePicture picTmp
      set picTmp = Nothing   
    'end if
  end if
end sub

' ------------------------------------------------------------------------------------
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

' ------------------------------------------------------------------------------------
sub PrintInfo( byref picRef, byref pic )
  if sStampInfo = "" then exit sub
  
  pic.Load False	' Force picture reloading
  
  ' Write the text at the bottom of the picture
  dim rect
  set rect = CreateObject("MyAlbum.rect")
  rect.x = 0
  rect.y = 0
  rect.w = pic.w
  rect.h = pic.h
  pic.drawText alb.ExpandMacro( picRef, sStampInfo ), rect, font, textColor, textBkColor, DT_SINGLELINE or DT_BOTTOM or DT_CENTER or DT_NOPREFIX
  set rect = Nothing
end sub

' ------------------------------------------------------------------------------------
sub GetPictureOffset( byref pix, byref xP, byref yP)
  dim s, T
  s = pix.GetCustomField( "Offset" )
  app.Trace "Current offset = " & s
  if s = "" then s = "0,0"
  T = Split( s, ",", -1, 1 )
  xP = CInt(T(0))
  yP = CInt(T(1))
end sub

' ------------------------------------------------------------------------------------
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