PureBoard

Code: Alles auswählen

;/ Silbentrennung
;/ Algorithmus von Frankling Mark Liang (1983)
;/ basierend auf "hyphenator für HTML" (Mathias Nater, Zürich)
;/ Mai 2009 Thorsten Hoeppner (Thorsten1867)


Structure LangStructure
  shortestPattern.b
  longestPattern.b
  leftmin.b
  rightmin.b
EndStructure
Global Language.LangStructure

Structure PatternStructure
  chars.s
  pattern.s
EndStructure
Global NewList HyphPattern.PatternStructure(), NewList pattern.PatternStructure()

Procedure LoadPattern(PatternFile.s)
  ClearList(HyphPattern())
  If ReadFile(0, PatternFile.s)
    While Eof(0) = 0 
      pattern$ = Trim(ReadString(0,#PB_UTF8))
      AddElement(HyphPattern())
      HyphPattern()\chars = StringField(pattern$,1,":")
      HyphPattern()\pattern = StringField(pattern$,2,":")
    Wend 
    CloseFile(0)
    Select GetExtensionPart(PatternFile) ;{ Spracheinstellungen
      Case "de"
        Language\shortestPattern = 2
        Language\longestPattern = 9
        Language\leftmin = 2
        Language\rightmin = 2
      Case "en"
        Language\shortestPattern = 2
        Language\longestPattern = 8
        Language\leftmin = 2
        Language\rightmin = 2
      Case "fr"
        Language\shortestPattern = 1
        Language\longestPattern = 14
        Language\leftmin = 2
        Language\rightmin = 2
    EndSelect ;}
  Else
    MessageRequester("Lade Trennungsmuster", "Datei konnte nicht eingelesen werden.", 0)
  EndIf
EndProcedure

Procedure MathMin(zahl1, zahl2)
  If zahl1 < zahl2
    ProcedureReturn zahl1
  Else
    ProcedureReturn zahl2
  EndIf
EndProcedure

Procedure.b IsNumber(char$)
  If Asc(char$) >= 48 And Asc(char$) <= 57
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.s GetPattern(chars.s)
  ForEach pattern()
    If chars = pattern()\chars
      ProcedureReturn pattern()\pattern
    EndIf
  Next
EndProcedure

Procedure.s InsertString(string.s, idx.b, chars.s)
  If idx > 1
    result.s = Left(string, idx-1)+chars+Mid(string, idx)
  ElseIf idx >= Len(string)
    result.s = string + chars
  Else
    result.s = chars + string
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s HyphenateWord(wort.s)
  wort = "_"+wort+"_"
  word.s = LCase(wort)
  WLen.b = Len(word)
  
  ;{ Suche Pattern
  ClearList(pattern())
  ForEach HyphPattern()
    If FindString(word, HyphPattern()\chars, 1)
      AddElement(pattern())
      pattern()\chars = HyphPattern()\chars
      pattern()\pattern = HyphPattern()\pattern
    EndIf
  Next
  ;}
  
  Dim Hypos.s(WLen)
  
  n = WLen - Language\shortestPattern
  For p = 1 To n+1
    max = MathMin(WLen-p+1, Language\longestPattern)
    For w = Language\shortestPattern To max
      pattern.s = GetPattern(Mid(word, p, w))
      If pattern
        digits = 1
        PLen = Len(pattern)
        For i=1 To PLen ; Pattern auswerten
          char$ = Mid(pattern, i, 1)
          If IsNumber(char$)
            If i = 1
              z = p
            Else
              z = p + i - digits
            EndIf
            If Not Hypos(z) Or Hypos(z) < char$
              Hypos(z) = char$
            EndIf
            digits + 1
          EndIf
        Next
      EndIf
    Next
  Next
  inserted.b = 0
  For i = Language\leftmin To WLen-Language\rightmin
    If Val(Hypos(i))
      wort = InsertString(wort, i + inserted, Hypos(i))
      inserted + 1
    EndIf
  Next
  
  result.s = RemoveString(wort, "_")
  For i = 1 To 9
    Select i
      Case 1,3,5,7,9
        result = ReplaceString(result, Str(i), "|")
      Case 2,4,6,8
        result = RemoveString(result, Str(i))
    EndSelect
  Next
  If Left(result,1) = "|" : result = Mid(result,2) : EndIf
  ProcedureReturn result
EndProcedure

LoadPattern("HyphenPattern.de")

wort$ =  InputRequester("Silbentrennung", "Wort eingeben:", "")
result$ = HyphenateWord(wort$)
MessageRequester("Silbentrennung", ReplaceString(result$, "|", " - "), #MB_OK)