Side "Fack" - Printable Version

Code: (Select All)
'2023-06-29 took over an hour to get debugged



Dim tr$(1 To 100000), f$(1 To 100000)

Dim As Long trI, fI, i

Dim buf$, wd$

Dim Shared rec15 As String * 15

Dim Shared NTopWord As Long

Dim Shared n$

nl$ = Chr$(13) + Chr$(10) ' eh too much work here for little joke

Open "Collins_Word_List.RA" For Random As #1 Len = 15

NTopWord = LOF(1) / 15

For i = 1 To NTopWord

    Get #1, i, rec15

    wd$ = _Trim$(rec15)

    If InStr(wd$, "TR") Then trI = trI + 1: tr$(trI) = wd$

Next



Open "tr to f.txt" For Output As #2

For i = 1 To trI

    wd$ = strReplace$(tr$(i), "TR", "F")

    If Find&(wd$) Then

        Print tr$(i), wd$

        Print #2, tr$(i), wd$

    End If

Next

Close



Function Find& (x$) ' if I am using this only to find words in dictionary, I can mod to optimize

    ' the RA file is opened and ready for gets

    Dim As Long low, hi, test

    Dim w$

    If Len(x$) < 2 Then Exit Function ' words need to be 3 letters

    low = 1: hi = NTopWord

    While low <= hi

        test = Int((low + hi) / 2)

        Get #1, test, rec15

        w$ = _Trim$(rec15)

        If w$ = x$ Then

            Find& = test: Exit Function

        Else

            If w$ < x$ Then low = test + 1 Else hi = test - 1

        End If

    Wend

End Function



Function strReplace$ (s$, replace$, new$) 'case sensitive  2020-07-28 version

    Dim p As Long, sCopy$, LR As Long, lNew As Long

    If Len(s$) = 0 Or Len(replace$) = 0 Then

        strReplace$ = s$: Exit Function

    Else

        LR = Len(replace$): lNew = Len(new$)

    End If



    sCopy$ = s$ ' otherwise s$ would get changed

    p = InStr(sCopy$, replace$)

    While p

        sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)

        p = InStr(p + lNew, sCopy$, replace$)

    Wend

    strReplace$ = sCopy$

End Function