'---------------------------------------------------------------------
'			Export2ProShow.vbs
'  This script exports the current album as a Photodex Proshow Gold
'  slideshow.
'  Tested with Proshow Gold 1.2
'---------------------------------------------------------------------

Option Explicit

Const ForReading = 1, ForWriting = 2

' The titles of the slides will be constructed using this display string
const sSlideTitle = "%C8, %1C"
' Position of the caption on the slide (more or less centered at the bottom)
const slideTitleXPos = 5034
const slideTitleYPos = 9100

const scallingLandscape = 5	' use "Fill safe zone" scaling mode (5)
const scallingPortrait  = 4	' use "Fit to safe zone" scaling mode (4)

const transId = 0		' Default transition between slides (use 1 for none and 0 for random)
const transTime = 1000		' Transition time (in ms)

app.ClearTrace

dim alb, pic, nb, i, iP, fso, f, outputFileName, T, s, k, sFolderPrefix, sP
set alb = app.GetCurrentAlbum()
nb = alb.nbVisiblePicture
app.Trace nb & " pictures to process", -1, TRACE_INFORMATION

outputFileName = app.GetFileName( "Select the output Proshow slideshow file", 1, "test.psh", "ProShow file (*.psh)|*.psh|All files (*.*)|*.*||", 0)
app.Trace "Creating ProShow file: " & outputFileName, -1, TRACE_ARROW

' ProShow has a strange way of specifying the path to the items in the slideshow file
T = Split( outputFileName, "\", -1, 1 )
sFolderPrefix = ""
if UBound(T) = 0 then
  sFolderPrefix = "./"
else
  for i = 0 to UBound(T)-1
    sFolderPrefix = sFolderPrefix & "../"
  next
end if

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile( outputFileName, ForWriting, True)
f.WriteLine "Photodex(R) ProShow(TM) Show File Version=0"
f.WriteLine "title=" & alb.sAlbumTitle
f.WriteLine "fileName=My Computer/" & Replace( outputFileName, "\", "/" )
f.WriteLine "showSizeX=640"
f.WriteLine "showSizeY=480"
f.WriteLine "loop=1"
f.WriteLine "loopRestart=1"
f.WriteLine "displaySizeX=704"
f.WriteLine "displaySizeY=528"
f.WriteLine "videoSizeX=352"
f.WriteLine "videoSizeY=240"
f.WriteLine "outputImageSizeX=1024"
f.WriteLine "outputImageSizeY=768"
'f.WriteLine "ctaLabel=ProShow Info"
'f.WriteLine "ctaURL=http://www.photodex.com/"

if ProcessPlayCmd( alb.sPlayCmd, T ) then
  app.Trace "Adding global background music"
  s = ""
  k = 0
  for i=0 to UBound(T)
    if s <> "" then s = s & vbcrlf
    s = s & "sound[" & k & "].file=" & sFolderPrefix & Replace( T(i), "\", "/" ) & vbCRLF & "sound[" & k & "].volume=100"
    app.Trace vbTab & T(i)
    k = k + 1
  next
  if k > 0 then
    f.WriteLine "sounds=" & k & vbCRLF & s
  end if
end if

f.WriteLine "cells=" & alb.nbSelectedPicture-1

iP = 0
For i = 0 To nb-1
  Set pic = alb.GetVisiblePicture(i)
  if pic.bSelected then
    app.Trace "  Exporting picture '" & pic.sShortFileName & "'..."
    sP = "cell[" & iP & "]."
    iP = iP + 1
    f.WriteLine sP & "imageEnable=1"
    f.WriteLine sP & "image=" & sFolderPrefix & Replace( alb.ExpandMacro( pic, "%RP" ), "\", "/" )
    ' Select the scaling methode based on the orientation of the picture
    if pic.w > pic.h then
      ' "landscape" picture
      f.WriteLine sP & "sizeMode=" & scallingLandscape
    else
      ' "portrait" picture
      f.WriteLine sP & "sizeMode=" & scallingPortrait
    end if  
    f.WriteLine sP & "zoom=10000"
    f.WriteLine sP & "opacity=255"
    f.WriteLine sP & "colorizeColor=8421504"
    f.WriteLine sP & "background=1"
    f.WriteLine sP & "bgDefault=1"

    if ProcessPlayCmd( pic.sPlayCmd, T ) then
      app.Trace vbTab & "Adding picture-level background music " & T(0)
      f.WriteLine sP & "sound.file=" & sFolderPrefix & Replace( T(0), "\", "/" )    
    end if
    
    f.WriteLine sP & "sound.useDefault=1"
    f.WriteLine sP & "sound.volume=100"
    f.WriteLine sP & "sound.fadeIn=100"
    f.WriteLine sP & "sound.fadeOut=100"
    f.WriteLine sP & "sound.async=1"
    f.WriteLine sP & "sound.musicUseDefault=1"
    f.WriteLine sP & "sound.musicVolume=50"
    f.WriteLine sP & "sound.musicFadeIn=100"
    f.WriteLine sP & "sound.musicFadeOut=100"
    f.WriteLine sP & "musicVolumeOffset=50"
    'f.WriteLine sP & "cell[13].includeGlobalCaptions=1

    f.WriteLine sP & "time=" & GetPicDelay( pic )
    if transId = 0 then
      f.WriteLine sP & "transIdRandom=1"
    else
      f.WriteLine sP & "transId=" & transId
    end if
    f.WriteLine sP & "transTime=" & transTime
    f.WriteLine sP & "includeGlobalCaptions=1"
    if sSlideTitle <> "" then
      f.WriteLine sP & "captions=1"
      dim sP2
      sP2 = sP & "caption[0]."
      f.WriteLine sP2 & "r.left=" & slideTitleXPos
      f.WriteLine sP2 & "r.top=" & slideTitleYPos
      f.WriteLine sP2 & "text=""" & alb.ExpandMacro( pic, sSlideTitle ) & """"
      f.WriteLine sP2 & "logFont.lfHeight=1600"
      f.WriteLine sP2 & "logFont.lfWeight=400"
      f.WriteLine sP2 & "logFont.lfFaceName=Arial Narrow"
      f.WriteLine sP2 & "color=16777215"
      f.WriteLine sP2 & "opacity=255"
      f.WriteLine sP2 & "just=2"
      f.WriteLine sP2 & "shadowOpacity=128"
      f.WriteLine sP2 & "outline=1"
      f.WriteLine sP2 & "imageZoom=10000"
    end if
  end if
Next
f.close

app.Trace iP & " pictures added to the slideshow", -1, TRACE_INFORMATION
app.Trace "Done!", -1, TRACE_GREENDOT

'--------------------------------------------------------------------------
Function ProcessPlayCmd( sPlayCmd, byref T )
  dim i, k, TL, n
  ProcessPlayCmd = False
  TL = Split( sPlayCmd, vbcrlf, -1, 1 )
  k = UBound(TL)
  if k <= 0 then exit function
  n = 0
  for i = 0 to k
    'app.Trace TL(i)
    dim tI
    tI = Split( TL(i), "|", -1, 1 )
    if (UBound(tI) > 0) then
      if tI(0) = "media" or tI(0) = "wav" then
        redim preserve T(n)
        T(n) = tI(1)
        n = n+1
      end if
    end if
  next
  ProcessPlayCmd = n > 0
End Function

'--------------------------------------------------------------------------
function GetPicDelay( byref pic )
  dim n
  if (pic.lStatus and &hff) <> TYPE_VID then
    n = pic.lTransition and &hffff
    if n = 65535 then n = alb.nDelaySlideshow
    n = CInt(n * 100)
    if n = 0 then n = 2000
    GetPicDelay = CStr(n)
  else
    GetPicDelay = 1000		' 1 second for videos
  end if
end function