Attribute VB_Name = "Rut_PSI"
Option Explicit

Public Const NUM_PSIPROP_PREDEF = 5   ' nº de propiedades 'predefinidas'
Private Const DELIM_CMP = """"
Private Const SEPAR_CMP = ","

' crea un nuevo PSI con los datos que se pasan como parámetros
' devuelve True si pudo crearlo, False si no
Public Function NuevoPSI(ByVal sNombre As String, ByVal sAdjetivo As String, _
  ByVal sDescCorta As String, ByVal sDescLarga As String, _
  ByVal lPeso As Long, ByVal lTam As Long, ByVal sLocalidad As String, _
  ByVal sPropiedades As String) As Boolean
    Dim i As Long, n As Long
    
    sNombre = QuitaAcentos(Trim(UCase(sNombre)))
    sAdjetivo = QuitaAcentos(Trim(UCase(sAdjetivo)))
    
    If Not bHayPSI Then
        n = 0
    Else
        n = UBound(PSIs)
        
        ' comprueba si el PSI ya existe
        For i = 0 To n
            If PSIs(i).Nombre = sNombre And PSIs(i).Adjetivo = sAdjetivo Then
                MsgBox "El PSI " & JuntaNombreAdj(sNombre, sAdjetivo) & " está repetido.", vbOKOnly + vbExclamation, "ERROR"
                NuevoPSI = False
                Exit Function
            End If
        Next
        
        n = n + 1
    End If
    
    ReDim Preserve PSIs(n)

    PSIs(n).Nombre = sNombre
    PSIs(n).Adjetivo = sAdjetivo
    PSIs(n).DescCorta = sDescCorta
    PSIs(n).DescLarga = sDescLarga
    PSIs(n).Peso = lPeso
    PSIs(n).Tam = lTam
    PSIs(n).Localidad = sLocalidad
    PSIs(n).Propiedades = sPropiedades
    If HayPropUsrPSI Then
        ReDim PSIs(n).PropUsr(UBound(PSIProp) - NUM_PSIPROP_PREDEF)
    Else
        ReDim PSIs(n).PropUsr(0)
    End If
    
    bHayPSI = True
    NuevoPSI = True

End Function

' borra un PSI
Public Sub BorrarPSI(ByVal lPos As Long)
    Dim i As Long, n As Long

    If Not bHayPSI Then
        Exit Sub
    End If

    n = UBound(PSIs)

    If lPos > n Then
        Exit Sub
    End If
    
    For i = lPos To n - 1
        PSIs(i) = PSIs(i + 1)
    Next

    If n = 0 Then
        ReDim PSIs(0)
        bHayPSI = False
    Else
        ReDim Preserve PSIs(n - 1)
    End If
    
End Sub

' guarda la tabla de PSIs, devuelve False si error
Public Function GuardarPSIs(ByVal sFich As String) As Boolean
    Dim iFich As Integer
    Dim i As Long, j As Long

    On Error GoTo Error_GuardarPSIs2

    iFich = FreeFile
    Open sFich For Output As #iFich

    ' propiedades de usuario
    If HayPropUsrPSI Then
        For i = NUM_PSIPROP_PREDEF To UBound(PSIProp)
            Print #iFich, DELIM_CMP & CStr(PSIProp(i).Tipo) & DELIM_CMP & SEPAR_CMP & _
              DELIM_CMP & PSIProp(i).Nombre & DELIM_CMP & SEPAR_CMP
        Next
    End If

    ' si está vacia la tabla de PSIs sale, pero deja el fichero en blanco
    If Not bHayPSI Then
        Close #iFich
        GuardarPSIs = True
        Exit Function
    End If
    On Error GoTo Error_GuardarPSIs1
    
    For i = 0 To UBound(PSIs)
        Print #iFich, "*" & PSIs(i).Nombre
        Print #iFich, "+" & PSIs(i).Adjetivo
        Print #iFich, "{" & CStr(Len(PSIs(i).DescCorta)) & "}" & PSIs(i).DescCorta
        Print #iFich, "{" & CStr(Len(PSIs(i).DescLarga)) & "}" & PSIs(i).DescLarga
        Print #iFich, PSIs(i).Peso
        Print #iFich, PSIs(i).Tam
        Print #iFich, PSIs(i).Localidad
        Print #iFich, PSIs(i).Propiedades
        Print #iFich, "{" & CStr(Len(PSIs(i).Grafico)) & "}" & PSIs(i).Grafico
        Print #iFich, "{" & CStr(Len(PSIs(i).Sonido)) & "}" & PSIs(i).Sonido
        '''Print #iFich, "{" & CStr(Len(PSIs(i).Usuario)) & "}" & PSIs(i).Usuario
        
        ' si hay propiedades definidas por el usuario las guardamos
        If HayPropUsrPSI Then
            For j = 0 To UBound(PSIs(i).PropUsr)
                Print #iFich, "{" & CStr(Len(PSIs(i).PropUsr(j))) & "}" & PSIs(i).PropUsr(j)
            Next
            For j = j To UBound(PSIProp) - NUM_PSIPROP_PREDEF
                Print #iFich, "{0}"
            Next
        End If
    Next
    
    Close #iFich
    GuardarPSIs = True
    Exit Function
    
Error_GuardarPSIs1:
    Close #iFich
Error_GuardarPSIs2:
    MsgBox "Error al guardar la tabla de PSIs: " & Err.Description, _
      vbOKOnly + vbCritical, "Error"
    GuardarPSIs = False
End Function

' carga la tabla de PSIs, devuelve False si error
Public Function CargarPSIs(ByVal sFich As String) As Boolean
    Dim iFich As Integer
    Dim i As Long, n As Long
    Dim c As String, sTipo As String, sNombre As String

    On Error GoTo Error_CargarPSIs2
    PropiedadesPSIs
    
    ReDim PSIs(0)
    bHayPSI = False

    iFich = FreeFile
    Open sFich For Input As #iFich
    On Error GoTo Error_CargarPSIs1
    
    ' si el fichero está vacío, sale
    If EOF(iFich) Then
        Close iFich
        CargarPSIs = True
        Exit Function
    End If
        
    ' propiedades de usuario
    Line Input #iFich, c
    If Left(c, 1) <> "*" Then
        ' si no hay propiedades predefinidas cogemos
        ' como índice -1 para que luego al incrementarse
        ' empiece en 0, en otro caso cogemos el índice
        ' del último elemento de la lista
        If PSIProp(0).Nombre = "" Then
            n = -1
        Else
            n = UBound(PSIProp)
        End If

        Do While True
            n = n + 1
            ReDim Preserve PSIProp(n)
            
            sTipo = SeparaCampo(c, 1, DELIM_CMP, SEPAR_CMP)
            sNombre = SeparaCampo(c, 2, DELIM_CMP, SEPAR_CMP)
            PSIProp(n).Tipo = CInt(sTipo)
            PSIProp(n).Nombre = UCase(sNombre)
            
            If EOF(iFich) Then
                Exit Do
            Else
                Line Input #iFich, c
                If Left(c, 1) = "*" Then
                    Exit Do
                End If
            End If
        Loop
    End If
    
    ' cargamos PSIs y sus propiedades
    n = 0
    Do While Not EOF(iFich)
        ReDim Preserve PSIs(n)
        
        PSIs(n).Nombre = Mid(c, 2)
        Line Input #iFich, c
        PSIs(n).Adjetivo = Mid(c, 2)
        PSIs(n).DescCorta = LeeDescripcion(iFich)
        PSIs(n).DescLarga = LeeDescripcion(iFich)
        Line Input #iFich, c
        PSIs(n).Peso = CLng(c)
        Line Input #iFich, c
        PSIs(n).Tam = CLng(c)
        Line Input #iFich, c
        PSIs(n).Localidad = c
        Line Input #iFich, c
        PSIs(n).Propiedades = c
        PSIs(n).Grafico = LeeDescripcion(iFich)
        PSIs(n).Sonido = LeeDescripcion(iFich)
        '''PSIs(n).Usuario = LeeDescripcion(iFich)
                
        ' si hay propiedades definidas por el usuario las cargamos
        If HayPropUsrPSI Then
            ReDim PSIs(n).PropUsr(UBound(PSIProp) - NUM_PSIPROP_PREDEF)
            For i = 0 To UBound(PSIs(n).PropUsr)
                PSIs(n).PropUsr(i) = LeeDescripcion(iFich)
            Next
        Else
            ReDim PSIs(n).PropUsr(0)
        End If
        
        n = n + 1
        If Not EOF(iFich) Then
            Line Input #iFich, c
        End If
    Loop

    Close #iFich
    
    If n > 0 Then
        bHayPSI = True
    End If
    
    CargarPSIs = True
    Exit Function

Error_CargarPSIs2:
    Close #iFich
Error_CargarPSIs1:
    ReDim PSIs(0)
    bHayPSI = False
    MsgBox "Error al cargar la tabla de PSIs: " & Err.Description, _
      vbOKOnly + vbCritical, "Error"
    CargarPSIs = False
End Function

' busca el PSI especificado y devuelve el índice del mismo
' o -1 si no lo encontró
Public Function BuscaPSI(ByVal sPSI As String) As Long
    Dim i As Long
    Dim sNombre As String, sAdj As String
    
    SeparaNombreAdj sPSI, sNombre, sAdj
    For i = 0 To UBound(PSIs)
        If PSIs(i).Nombre = sNombre And PSIs(i).Adjetivo = sAdj Then
            BuscaPSI = i
            Exit Function
        End If
    Next

    BuscaPSI = -1
    
End Function

' rellena la tabla de propiedades de los PSIs
Public Sub PropiedadesPSIs()
    
    If NUM_PSIPROP_PREDEF > 0 Then
        ReDim PSIProp(NUM_PSIPROP_PREDEF - 1)
        PSIProp(0).Nombre = PSI_PROP_FEMENINO
        PSIProp(0).Tipo = TIPO_PROP_SINO
        PSIProp(1).Nombre = PSI_PROP_PLURAL
        PSIProp(1).Tipo = TIPO_PROP_SINO
        PSIProp(2).Nombre = PSI_PROP_INVISIBLE
        PSIProp(2).Tipo = TIPO_PROP_SINO
        PSIProp(3).Nombre = PSI_PROP_MUERTO
        PSIProp(3).Tipo = TIPO_PROP_SINO
        PSIProp(4).Nombre = PSI_PROP_ESCENARIO
        PSIProp(4).Tipo = TIPO_PROP_SINO
    Else
        ReDim PSIProp(0)
    End If
    
End Sub
    
' devuelve el valor de una propiedad de un PSI
' también ejecuta los métodos asociados a PSIs
' devuelve Chr(0) si error
Public Function PropiedadPSI(ByVal sNombre As String, ByVal sPropiedad As String, _
  ByVal sParam As String) As String
    Dim i As Long, lPSI As Long
    Dim sP1 As String

    ' si el nombre pasado es un número accedemos al PSI por su número de orden
    ' si no por su nombre
    On Error Resume Next
    i = CLng(sNombre)
    If Err.Number = 0 Then
        lPSI = i
        If Err.Number <> 0 Then
            PropiedadPSI = Chr(0)
            Exit Function
        End If
    Else
        lPSI = BuscaPSI(sNombre)
        If PSIs(lPSI).Nombre = "" Then
            PropiedadPSI = Chr(0)
            Exit Function
        End If
    End If
    
    Err.Clear
    sPropiedad = UCase(sPropiedad)
    Select Case sPropiedad
        Case PSI_PROP_NOMBRE
            PropiedadPSI = PSIs(lPSI).Nombre
        Case PSI_PROP_ADJETIVO
            PropiedadPSI = PSIs(lPSI).Adjetivo
        Case PSI_PROP_DESCCORTA
            PropiedadPSI = PSIs(lPSI).DescCorta
        Case PSI_PROP_DESCLARGA
            PropiedadPSI = PSIs(lPSI).DescLarga
        Case PSI_PROP_LOCALIDAD
            PropiedadPSI = PSIs(lPSI).Localidad
        Case PSI_PROP_PESO
            PropiedadPSI = CStr(PSIs(lPSI).Peso)
        Case PSI_PROP_TAM
            PropiedadPSI = CStr(PSIs(lPSI).Tam)
        Case PSI_PROP_GRAFICO
            PropiedadPSI = PSIs(lPSI).Grafico
        Case PSI_PROP_SONIDO
            PropiedadPSI = PSIs(lPSI).Sonido
        Case PSI_PROP_USUARIO
            PropiedadPSI = PSIs(lPSI).Usuario
        Case METODO_OBJETOS
            ' PSI[expr].Objetos()
            '   devuelve un array con los objetos que lleva el PSI
            PropiedadPSI = ObjetosContenedor(OBJ_CONTPSI, JuntaNombreAdj(PSIs(lPSI).Nombre, PSIs(lPSI).Adjetivo))
        Case METODO_PESOOBJETOS
            ' PSI[expr].PesoObjetos()
            '   devuelve el peso total de los objetos que lleva el PSI
            PropiedadPSI = CStr(PesoObjetosContenedor(OBJ_CONTPSI, JuntaNombreAdj(PSIs(lPSI).Nombre, PSIs(lPSI).Adjetivo)))
        Case METODO_COGER
            ' PSI[expr].Coger(obj)
            sP1 = CogeParametro(sParam, 1)
            sP1 = AnalizaExpresion(sP1)
            If sP1 = Chr(0) Then
                PropiedadPSI = Chr(0)
            Else
                PropiedadPSI = IIf(PSICogeObjeto(lPSI, sP1), EXPR_TRUE, EXPR_FALSE)
            End If
        Case METODO_DEJAR
            ' PSI[expr].Dejar(obj)
            sP1 = CogeParametro(sParam, 1)
            sP1 = AnalizaExpresion(sP1)
            If sP1 = Chr(0) Then
                PropiedadPSI = Chr(0)
            Else
                PropiedadPSI = IIf(PSIDejaObjeto(lPSI, sP1), EXPR_TRUE, EXPR_FALSE)
            End If
        Case METODO_CONTIENE
            ' PSI[expr].Contiene(obj)
            sP1 = CogeParametro(sParam, 1)
            sP1 = AnalizaExpresion(sP1)
            If sP1 = Chr(0) Then
                PropiedadPSI = Chr(0)
            Else
                PropiedadPSI = IIf(ContieneObjeto(sP1, OBJ_CONTPSI, lPSI), EXPR_TRUE, EXPR_FALSE)
            End If
        Case METODO_MOVER
            ' PSI[expr].Mover(verbo)
            sP1 = CogeParametro(sParam, 1)
            sP1 = AnalizaExpresion(sP1)
            If sP1 = Chr(0) Then
                PropiedadPSI = Chr(0)
            Else
                PropiedadPSI = IIf(PSIMover(lPSI, sP1), EXPR_TRUE, EXPR_FALSE)
            End If
        Case Else
            ' propiedades definidas por el usuario
            For i = 0 To UBound(PSIProp)
                If UCase(PSIProp(i).Nombre) = sPropiedad Then
                    If i < NUM_PSIPROP_PREDEF Then
                        If Mid(PSIs(lPSI).Propiedades, i + 1, 1) = PROP_ACTIV Then
                            PropiedadPSI = EXPR_TRUE
                        Else
                            PropiedadPSI = EXPR_FALSE
                        End If
                    Else
                        PropiedadPSI = PSIs(lPSI).PropUsr(i - NUM_PSIPROP_PREDEF)
                    End If
                    Exit Function
                End If
            Next
            PropiedadPSI = Chr(0)
    End Select

End Function

' asigna el valor de una propiedad de un PSI
' devuelve Chr(0) si error
Public Function AsignaPropiedadPSI(ByVal sNombre As String, ByVal sPropiedad As String, _
  ByVal sValor As String) As String
    Dim i As Long, lPSI As Long

    ' si el nombre pasado es un número accedemos al PSI por su número de orden
    ' si no por su nombre
    On Error Resume Next
    i = CLng(sNombre)
    If Err.Number = 0 Then
        lPSI = i
        If Err.Number <> 0 Then
            AsignaPropiedadPSI = Chr(0)
            Exit Function
        End If
    Else
        lPSI = BuscaPSI(sNombre)
        If PSIs(lPSI).Nombre = "" Then
            AsignaPropiedadPSI = Chr(0)
            Exit Function
        End If
    End If
    
    Err.Clear
    sPropiedad = UCase(sPropiedad)
    Select Case sPropiedad
        Case PSI_PROP_NOMBRE
            AsignaPropiedadPSI = Chr(0)
            Exit Function
        Case PSI_PROP_ADJETIVO
            AsignaPropiedadPSI = Chr(0)
            Exit Function
        Case PSI_PROP_DESCCORTA
            PSIs(lPSI).DescCorta = sValor
        Case PSI_PROP_DESCLARGA
            PSIs(lPSI).DescLarga = sValor
        Case PSI_PROP_LOCALIDAD
            PSIs(lPSI).Localidad = sValor
        Case PSI_PROP_PESO
            PSIs(lPSI).Peso = CLng(sValor)
            If Err.Number <> 0 Then
                AsignaPropiedadPSI = Chr(0)
                Exit Function
            End If
        Case PSI_PROP_TAM
            PSIs(lPSI).Tam = CLng(sValor)
            If Err.Number <> 0 Then
                AsignaPropiedadPSI = Chr(0)
                Exit Function
            End If
        Case PSI_PROP_GRAFICO
            PSIs(lPSI).Grafico = sValor
        Case PSI_PROP_SONIDO
            PSIs(lPSI).Sonido = sValor
        Case PSI_PROP_USUARIO
            PSIs(lPSI).Usuario = sValor
        Case Else
            ' propiedades 'definibles por el usuario'
            For i = 0 To UBound(PSIProp)
                If UCase(PSIProp(i).Nombre) = sPropiedad Then
                    If i < NUM_PSIPROP_PREDEF Then
                        Mid(PSIs(lPSI).Propiedades, i + 1, 1) = IIf(sValor = EXPR_TRUE, PROP_ACTIV, PROP_DESACTIV)
                    Else
                        PSIs(lPSI).PropUsr(i - NUM_PSIPROP_PREDEF) = sValor
                    End If
                    AsignaPropiedadPSI = sValor
                    Exit Function
                End If
            Next
            AsignaPropiedadPSI = Chr(0)
            Exit Function
    End Select

    AsignaPropiedadPSI = sValor

End Function

' el PSI coge un objeto
' devuelve True si pudo, False si no
Private Function PSICogeObjeto(ByVal lPSI As Long, ByVal sObj As String) As Boolean
    Dim lObj As Long

    PSICogeObjeto = False
    
    lObj = BuscaObjeto(sObj)
    If lObj < 0 Then
        DescError "No se ha encontrado el objeto: " & sObj
        Exit Function
    End If

    ' comprobamos si el objeto está al alcance del PSI
    If Objetos(lObj).TipoContenedor = OBJ_CONTLOC _
      And Objetos(lObj).Contenedor = PSIs(lPSI).Localidad Then
        Objetos(lObj).TipoContenedor = OBJ_CONTPSI
        Objetos(lObj).Contenedor = JuntaNombreAdj(PSIs(lPSI).Nombre, PSIs(lPSI).Adjetivo)
        PSICogeObjeto = True
    End If

End Function

' el PSI deja un objeto
' devuelve True si pudo, False si no
Private Function PSIDejaObjeto(ByVal lPSI As Long, ByVal sObj As String) As Boolean
    Dim lObj As Long

    lObj = BuscaObjeto(sObj)
    If lObj < 0 Then
        DescError "No se ha encontrado el objeto: " & sObj
        PSIDejaObjeto = False
        Exit Function
    End If
    
    ' comprobamos si el PSI tiene el objeto
    If Objetos(lObj).TipoContenedor = OBJ_CONTPSI And _
      Objetos(lObj).Contenedor = JuntaNombreAdj(PSIs(lPSI).Nombre, PSIs(lPSI).Adjetivo) Then
        PSIDejaObjeto = PonerObjeto(lObj, OBJ_CONTLOC, PSIs(lPSI).Localidad)
    Else
        PSIDejaObjeto = False
    End If

End Function

' mueve un PSI siguiendo un verbo de movimiento
' devuelve True si pudo, False si no
Private Function PSIMover(ByVal lPSI As Long, ByVal sMov As String) As Boolean
    Dim i As Long, n As Long, lPal As Long, lLoc As Long

    sMov = UCase(sMov)
    lPal = EstaEnVoc(sMov, -1, 0)
    ' sustituimos por el sinónimo (si tiene)
    If Vocabulario(lPal).Sinonimo <> "" Then
        sMov = Vocabulario(lPal).Sinonimo
    End If
    
    lLoc = BuscaLocalidad(PSIs(lPSI).Localidad)
    If lLoc < 0 Then
        PSIMover = False
        Exit Function
    End If
    
    ' buscamos entre las conexiones de la localidad del PSI
    n = UBound(Localidades(lLoc).Conexiones)
    For i = 0 To n
        If Localidades(lLoc).Conexiones(i).Verbo = sMov Then
            ' comprobamos si la conexión está abierta
            If Localidades(lLoc).Conexiones(i).Abierta Then
                PSIs(lPSI).Localidad = Localidades(lLoc).Conexiones(i).Localidad
                PSIMover = True
            Else
                PSIMover = False
            End If
            Exit Function
        End If
    Next
    
    PSIMover = False
    
End Function

' devuelve el nº de PSI correspondiente al jugador (var. global 'PSIJugador')
' si la no se encontró el PSI devuelve -1
Public Function NumPSIJugador() As Long
    Dim sPSIJugador As String
    Dim lPSIJugador As String

    sPSIJugador = UCase(ValorVariable(PSI_JUGADOR))

    ' si es numérica la devolvemos tal cual
    ' en otro caso buscamos el PSI correspondiente
    On Error Resume Next
    lPSIJugador = CLng(sPSIJugador)
    If Err.Number = 0 Then
        NumPSIJugador = lPSIJugador
        Exit Function
    End If
    
    ' buscamos el PSI con el nombre dado
    NumPSIJugador = BuscaPSI(sPSIJugador)

End Function

' devuelve True si hay propiedades de usuario definidas para los PSIs
Public Function HayPropUsrPSI() As Boolean

    If UBound(PSIProp) >= NUM_PSIPROP_PREDEF And Trim(PSIProp(0).Nombre) <> "" Then
        HayPropUsrPSI = True
    Else
        HayPropUsrPSI = False
    End If
    
End Function