Attribute VB_Name = "Engine"
''The copyright for the following is held by Jure Sah.
''It may be copied or modified only if Jure Sah writes
''a premition in the form of a newer copyright.

''Here is the engine of the program!
''After making the program work with lists and HTML tags, it all wen't screwed, so I started over and picked another alternative... without lists.

Public Sub Calculate()
InData$ = Window.Data.Text


''Insert code to construct the string of tags here. The program tolerates any format one could think of, only if there is a standard keyword lenght.
''That lenght also needs to be found as the value of the variable defined below.
MinL = Val(Window.KWL.Text)
''Don use whitespaces to lenghten keywords to standard lenghts! You can use underscores however.

''DATA is the input textbox
If Len(InData$) > 0 Then
 
 ''Fix DATA
 If Not Right$(InData$, 1) = "!" Then InData$ = InData$ + "!"
 tmp$ = ""
 For x = 1 To Len(InData$)
  If Not Mid$(InData$, x, 1) = " " Then tmp$ = tmp$ + Mid$(InData$, x, 1)
 Next x
 InData$ = tmp$
 Window.Data.Refresh

 ''Get all patterns
 Window.Patterns.Clear
 For x = 1 To Len(InData$) Step MinL
  MaxL = Len(InData$) - x
  For y = MinL To MaxL Step MinL
   ''PATTERNS is the listbox object titled "Patterns"
   Window.Patterns.AddItem Mid$(InData$, x, y)
  Next y
  DoEvents
 Next x
 Window.Patterns.Refresh
 
 ''Find repeating patterns
 ''This is all about scaning PATTERNS, finding the ones that repeat there and placing to RPPATTERNS only those that are not here yet.
 ''RPPATTERNS is a listbox object titiled "Repeating Patterns"
 Dim Found As Boolean
 Window.RpPatterns.Clear
 For x = 0 To Window.Patterns.ListCount - 1
  Window.Patterns.Selected(x) = True
  For y = 0 To Window.Patterns.ListCount - 1
   If x <> y And Window.Patterns.List(x) = Window.Patterns.List(y) Then
    Found = False
    For z = 0 To Window.RpPatterns.ListCount - 1
     If Window.RpPatterns.List(z) = Window.Patterns.List(y) Then Found = True
    Next z
    If Not Found Then
     Window.RpPatterns.AddItem Window.Patterns.List(x)
     Window.RpPatterns.Refresh: DoEvents
     Window.RpPatterns.Selected(Window.RpPatterns.ListCount - 1) = True
    End If
   End If
  Next y
 Next x
 
 ''Sort repeating patterns by size
 ''This is a standard sort procedure
 If Window.RpPatterns.ListCount > 1 Then
  For x = 0 To Window.RpPatterns.ListCount - 1
   Window.RpPatterns.Selected(x) = True
   For y = 0 To Window.RpPatterns.ListCount - 1
    ''Sort direction determinet by the option settings on the WINDOW
    If Len(Window.RpPatterns.List(x)) < Len(Window.RpPatterns.List(y)) Then
     tmp2 = Window.RpPatterns.List(x)
     tmp3 = Window.RpPatterns.List(y)
     Window.RpPatterns.List(x) = tmp3
     Window.RpPatterns.List(y) = tmp2
     Window.RpPatterns.Refresh: DoEvents
    End If
   Next y
  Next x
 End If
 
 ''Find exceptions
 ''This is to fill EXCEP, RKEYS and USE
 ''EXCEP is a textbox object titled "Exceptions"
 ''RKEYS is a textbox object titled "Return keys"
 ''USE is a listbox object titled "Usefull patterns"
 ''You're probably only looking for the value of RKEYS, so note that the others are required to determine it!
 RKey$ = ""
 Dim Used As Boolean
 tmp$ = InData$
 Window.Use.Clear
 For x = 0 To Window.RpPatterns.ListCount - 1
  Window.RpPatterns.Selected(x) = True
  Used = False
  d$ = Window.RpPatterns.List(x)
5 i = InStr(tmp$, d$)
  If i > 0 Then
   Mid$(tmp$, i, Len(d$)) = String$(Len(d$), "*")
   Exc$ = tmp$
   Used = True
   GoTo 5
  End If
  If Used Then Window.Use.AddItem d$: RKey$ = RKey$ + d$
  DoEvents
 Next x
 Exc$ = tmp$
 
 ''Split return to keywords.
 Window.KWDS.Clear
 For x = 1 To Len(RKey$) Step MinL
  Window.KWDS.AddItem Mid$(RKey$, x, MinL)
  DoEvents
 Next x
 
 ''Sort keyword list according to original
 For x = 0 To Window.KWDS.ListCount - 1
  For y = 0 To Window.KWDS.ListCount - 1
  a = InStr(InData$, Window.KWDS.List(x))
  b = InStr(InData$, Window.KWDS.List(y))
  If a < b Then
   tmp2 = Window.KWDS.List(x)
   tmp3 = Window.KWDS.List(y)
   Window.KWDS.List(x) = tmp3
   Window.KWDS.List(y) = tmp2
   Window.KWDS.Refresh
  End If
  Next y
  DoEvents
 Next x
End If
Window.Excep.Text = Exc$
Window.RKeys.Text = RKey$
DoEvents
End Sub