Attribute VB_Name = "Rut_Voc"
Option Explicit

' inserta una nueva palabra en el vocabulario
' devuelve True si pudo o False si no
' si el parámetro 'bSilencioso' es True no se mostrarán mensajes de error
Public Function NuevaPalabra(ByVal sPalabra As String, ByVal iTipo As Integer, _
  ByVal sSinonimo As String, ByVal bSilencioso As Boolean) As Boolean
    Dim i As Long, n As Long
    
    sPalabra = Trim(UCase(sPalabra))
    sSinonimo = Trim(UCase(sSinonimo))
    
    ' eliminamos los acentos de las palabras
    sPalabra = QuitaAcentos(sPalabra)
    sSinonimo = QuitaAcentos(sSinonimo)
    
    ' comprobamos las palabras
    If InStr(sPalabra, " ") >= 1 Then
        If Not bSilencioso Then
            MsgBox "La palabra " & sPalabra & " no es válida.", vbOKOnly + vbExclamation, "Nueva palabra"
        End If
        NuevaPalabra = False
        Exit Function
    End If
    If InStr(sSinonimo, " ") >= 1 Then
        If Not bSilencioso Then
            MsgBox "La palabra " & sSinonimo & " no es válida.", vbOKOnly + vbExclamation, "Nueva palabra"
        End If
        NuevaPalabra = False
        Exit Function
    End If
    
    If Not bHayVoc Then
        n = 0
    Else
        If EstaEnVoc(sPalabra, iTipo, 0) >= 0 Then
            If Not bSilencioso Then
                MsgBox "La palabra " & sPalabra & " está repetida.", vbOKOnly + vbExclamation, "Nueva palabra"
            End If
            NuevaPalabra = False
            Exit Function
        End If
        
        n = UBound(Vocabulario) + 1
    End If
    
    ReDim Preserve Vocabulario(n)

    Vocabulario(n).Palabra = sPalabra
    Vocabulario(n).Tipo = iTipo
    If iTipo = VOC_SINONIMO Then
        Vocabulario(n).Sinonimo = sSinonimo
    End If

    bHayVoc = True
    NuevaPalabra = True

End Function

Public Sub BorrarPalabra(ByVal lPos As Long)
    Dim sPalabra As String
    Dim i As Long, n As Long

    If Not bHayVoc Then
        Exit Sub
    End If

    n = UBound(Vocabulario)

    If lPos > n Then
        Exit Sub
    End If
    
    sPalabra = Vocabulario(lPos).Palabra
    
    For i = lPos To n - 1
        Vocabulario(i) = Vocabulario(i + 1)
    Next

    If n = 0 Then
        ReDim Vocabulario(0)
        bHayVoc = False
    Else
        ReDim Preserve Vocabulario(n - 1)
    End If
    
    ' borra los sinónimos que tuviese esa palabra
    BorrarSinonimos sPalabra

End Sub

Private Sub BorrarSinonimos(ByVal sPalabra As String)
    Dim Vocab0() As Palabra
    Dim bLleno As Boolean
    Dim i As Long, n As Long
    
    sPalabra = UCase(sPalabra)
    
    n = 0
    ReDim Vocab0(n)
    bLleno = False
    
    For i = 0 To UBound(Vocabulario)
        If Vocabulario(i).Tipo <> VOC_SINONIMO Or _
          (Vocabulario(i).Tipo = VOC_SINONIMO And Vocabulario(i).Sinonimo <> sPalabra) Then
            
            ReDim Preserve Vocab0(n)
            Vocab0(n) = Vocabulario(i)
            n = n + 1
            bLleno = True
        End If
    Next

    If Not bLleno Then
        ReDim vacbulario(0)
        bHayVoc = False
    Else
        n = UBound(Vocab0)
        ReDim Vocabulario(n)
        For i = 0 To n
            Vocabulario(i) = Vocab0(i)
        Next
    End If
    
End Sub

' guarda el vocabulario, devuelve False si error
Public Function GuardarVocabulario(ByVal sFich As String) As Boolean
    Dim iFich As Integer
    Dim i As Long

    On Error GoTo Error_GuardarVoc2

    iFich = FreeFile
    Open sFich For Output As #iFich

    ' si está vacío el vocabulario deja en blanco el fichero
    If Not bHayVoc Then
        Close #iFich
        GuardarVocabulario = True
        Exit Function
    End If

    On Error GoTo Error_GuardarVoc1
    
    For i = 0 To UBound(Vocabulario)
        Print #iFich, "*" & Vocabulario(i).Palabra
        Print #iFich, " =" & Vocabulario(i).Tipo
        Print #iFich, " +" & Vocabulario(i).Sinonimo
    Next
    
    Close #iFich
    GuardarVocabulario = True
    Exit Function
    
Error_GuardarVoc1:
    Close #iFich
Error_GuardarVoc2:
    MsgBox "Error al guardar el vocabulario: " & Err.Description, _
      vbOKOnly + vbCritical, "Error"
    GuardarVocabulario = False
End Function

' carga el vocabulario, devuelve False si error
Public Function CargarVocabulario(ByVal sFich As String) As Boolean
    Dim iFich As Integer
    Dim n As Long
    Dim c As String

    On Error GoTo Error_CargarVoc2

    n = 0
    ReDim Vocabulario(0)
    bHayVoc = False

    iFich = FreeFile
    Open sFich For Input As #iFich
    On Error GoTo Error_CargarVoc1
    
    Do While Not EOF(iFich)
        ReDim Preserve Vocabulario(n)
        
        Line Input #iFich, c
        Vocabulario(n).Palabra = Mid(c, 2)
        Line Input #iFich, c
        Vocabulario(n).Tipo = CInt(Mid(c, 3))
        Line Input #iFich, c
        Vocabulario(n).Sinonimo = Mid(c, 3)
         
        n = n + 1
    Loop

    Close #iFich
    
    If n > 0 Then
        bHayVoc = True
    End If
    
    CargarVocabulario = True
    Exit Function

Error_CargarVoc1:
    Close #iFich
Error_CargarVoc2:
    ReDim Vocabulario(0)
    bHayVoc = False
    MsgBox "Error al cargar el vocabulario: " & Err.Description, _
      vbOKOnly + vbCritical, "Error"
    CargarVocabulario = False
End Function

' devuelve la posición de una palabra en el vocabulario o -1 si no está
' busca entre las palabras cuyo tipo es 'iTipo', si 'iTipo' es -1
' busca entre todas las palabras
' comienza la búsqueda en la posición 'lInicio'
Public Function EstaEnVoc(ByVal sPal As String, ByVal iTipo As Integer, _
  lInicio As Long) As Long
    Dim i As Long, n As Long

    n = UBound(Vocabulario)
    
    If lInicio > n Then
        EstaEnVoc = -1
        Exit Function
    End If
    
    sPal = UCase(sPal)
    For i = lInicio To n
        If Vocabulario(i).Palabra = sPal Then
            If iTipo = -1 Or (iTipo <> -1 And Vocabulario(i).Tipo = iTipo) Then
                EstaEnVoc = i
                Exit Function
            End If
        End If
    Next

    EstaEnVoc = -1

End Function

' crea las tablas de nombres y adjetivos (rellena el vocabulario con nombres
' y adjetivos de los objetos)
Public Sub CreaTablasNombAdj()
    Dim i As Long
   
    ' extrae los nombres de las localidades
    If bHayLoc Then
        For i = 0 To UBound(Localidades)
            NuevaPalabra Localidades(i).Nombre, VOC_NOMBRE, "", True
        Next
    End If
    
    ' extrae los nombres y adjetivos de los objetos
    If bHayObj Then
        For i = 0 To UBound(Objetos)
            NuevaPalabra Objetos(i).Nombre, VOC_NOMBRE, "", True
            NuevaPalabra Objetos(i).Adjetivo, VOC_ADJETIVO, "", True
        Next
    End If
    
    ' extrae los nombres y adjetivos de los PSIs
    If bHayPSI Then
        For i = 0 To UBound(PSIs)
            NuevaPalabra PSIs(i).Nombre, VOC_NOMBRE, "", True
            NuevaPalabra PSIs(i).Adjetivo, VOC_ADJETIVO, "", True
        Next
    End If
    
End Sub