Anagrams

By Gordon
[http://sionet.mysite.wanadoo-members.co.uk/JustBasic.htm]

Here is way of creating Anagrams either from true words in any ASCII .TXT file or from random selected letters with a few vowels added. The latter is the basis of the long running UK COUNTDOWN TV program. I find many of the more clever folks in a Seniors Internet Forum with plenty of time on their hands like to try these, but I do not think they enjoy the Random letters so well. The program is based on an earlier LB version of mine using text windows which would not work with JB, but the process of converting it has improved it -- we never cease to learn with coding!!

To begin I selected the smaller 800 x 600 display to match all normal screen displays, leaving space for the bottom toolbar if needed. Beginners notice the use of FLUSH, so we do not lose the display if the [view] with notepad option is selected, and the use of FILL WHITE to allow the screen to be scrolled.

In the [true] section to extract words from a TXT file, beginners might note the use of Sub routines like [file] and [save] to avoid duplications of code, where needed more than once. Also the way the window is closed and reopened with the same #handle to not only to eliminate the buttons, but to make closure simpler. The ‘PLEASE WAIT’ notice is needed because even with on my 2.6 Gig CPU it takes a second or two to create lists. All the lines in a file are collected individually as i$ with a space added, and then added to lines$, which is converted to upper case for easier reading, and letter selection where unwanted characters are omitted next.

Note if a word is < 4 and too easy it is eliminated, also a warning no more that 500 words are accepted, so you need to cut and paste a large TXT file to smaller files, if you want to use it all. [space] eliminates any strange inter-word spaces. Next all the words are sorted in random order to avoid the user guessing the answers my making sense of the text. Next the same routine is used to sort the letters in random order. Note monitoring the length of check$ to achieve a simple form of line wrap, also you need to print the remnants in check$ after the loop is complete. Finally the user is given the option to save the lists for printing with notepad in [view] etc or clicking the standard X closure button which returns to the opening screen.

The [rand] option first stores the vowels in vwl$(v). You can see info$ is needed in [save] to create the respective file list; also I like to inform the user the name and path where file has been saved to save having to hunt for it afterwards. The length of the first word is set at 4, following words are increased in length by 1 up to 10 then set at 4 again, the number of necessary vowels being set at one third.

Alter the program to suite your taste and perhaps let us know your suggested changes in the JB forum.

    nomainwin
    WindowWidth = 800 : WindowHeight = 580
    dim vwl$(5) : dim t$(505) : dim new$(505)
[start]
    button #a, " View TXT file",[view],ul,100,300
    button #a, " Use TXT file ",[true],ul,250,300
    button #a, "Random Letters",[rand],ul,400,300
    button #a, "**** QUIT *** ",[quit],ul,550,300
    open "ANAGRAMS" for graphics_nsb as #a
    #a "trapclose [quit]; font arial 30 bold; color blue; place 300 100"
    #a "\JB Anagrams" : #a "font arial Bold 14; place 100 150"
    #a "\Use the Options to select either True Anagrams using random"
    #a "\selected words from any TXT file, or unknown words created"
    #a "\with random letters, which may not produce proper words."
    #a "\You will be gived the option to save the lists to a TXT file."
    #a "flush" : rand = 0
    redim t$(505) : redim new$(505)
    playwave "anything" : wait

[view]
    gosub [file]
    run$ = "notepad.exe "+F$
    run run$, showmaximized
    wait

[true]
    gosub [file]
    close #a : open "TRUE WORDS" for graphics as #a
    #a "trapclose [again]; fill white; color red"
    #a "font fixedsys 9; place 300 200"
    #a "\**** PLEASE WAIT ****"
    OPEN F$ FOR INPUT AS #2
    line$ = "" : ok = 0
    WHILE ok = 0
        IF EOF(#2) < 0 THEN ok = 1 : GOTO [fend]
        line input #2, i$
        line$ = line$ + i$ + " "
[fend]
    WEND : CLOSE #2
    line$ = upper$(line$) : word = 1

    ltr = 1 : ok = 1 ' Extract words from line$
    while ok = 1
        test$=""
        while test$ <> " "
            test$ = mid$(line$,ltr,1)
            asci = asc(test$)
            if asci < 65 or asc > 90 then [miss]
            t$(word) = t$(word) +test$
[miss]      ltr = ltr +1
            if test$ ="" then test$ = " " : ok = 0
        wend
        if len(t$(word)) < 4 then t$(word) = "" : word = word - 1
        word = word + 1
        if word > 500 then notice "LIMIT OF 500 REACHED" : ok = 0
[space]
        if mid$(line$,ltr,1) = " " then ltr = ltr +1 : goto [space]
    wend : word = word - 1
    if t$(word) ="" then word = word - 1 ' empty word

    new = 1 : max = word ' Sort Words random order
    while max > 1
        sel = int(rnd(1) * max) + 1
        new$(new) = t$(sel)
        new = new + 1
        'removes the random selected word
        for n = sel to max
            t$(n) = t$(n+1)
        next n
        max = max - 1
    wend
    new$(new) = t$(1)

    for n = 1 to word   ' Sort letters random
        t$(n) = ""
        temp$ = new$(n) : max = len(temp$)
        if max < 2 then t$(n) = temp$  : goto [miss2]
        while max > 0
            sel = int(rnd(1) * max) + 1
            t$(n) = t$(n) + mid$(temp$,sel,1)
        'remove the random selected letter
            a = sel-1 : b = max - sel
            temp$=left$(temp$,a) + right$(temp$,b)
            max = max - 1
        wend
[miss2] next n

    #a "cls; color black; place 20 20; fill white"
    #a "\*** THESE ARE ";word;" TRUE ANGRAMS WITH ANSWERS BELOW ***"
    check$ = "\"
    for t = 1 to word
        check$ = check$ + t$(t)+ " "
        if len(check$)>80 then #a check$ : check$="\"
    next t : #a check$

    b$ = "-" : info$="*** THESE ARE THE ";word; " ANSWERS ***"
    for z = 1 to 70: b$=b$+"-": next z
        #a "\";b$;"\";info$
    check$ = "\" ' List Words (answers)
    for t = 1 to word
        check$ = check$ + new$(t)+ " "
        if len(check$)>80 then #a check$ : check$="\"
    next t : #a check$ : #a "flush"
    confirm "Save the lists in a new TXT file?";q$
    if q$="yes" then [save]
    wait

[rand]
    rand=1 : restore [vdat]
    for v = 1 to 5
        read i$ : vwl$(v)=i$ 
    next v
    close #a : open "RANDOM WORDS" for graphics_nsb as #a
    #a "trapclose [again]; font fixedsys 9; place 20 20"
    info$="ARE ANY OF THESE ANAGRAMS OF TRUE WORDS?"
    #a "\";info$
[length] wlen = 4 : check$="\"
    for word = 1 to 300 :t$="" ' Z omitted
        vowel=int(wlen/3) : consn=wlen-vowel
        for  r = 1 to consn
            ltr=int(rnd(1)*25)+65
            t$=t$+chr$(ltr)
        next r
        for r = 1 to vowel
            ltr=int(rnd(1)*5)+1
            t$=t$+vwl$(ltr)
        next r
        new$(word)=tr$+t$ : check$=check$+new$(word)+" "
        if len(check$)>80 then #a check$ : check$="\"
        wlen = wlen +1 : if wlen > 10 then wlen = 4
    next word
    #a check$
    confirm "Save the lists in a new TXT file?";q$
    if q$="yes" then [save]
    wait

[file]
    F$="" : filedialog "Open ONLY a true TXT File","*.txt",F$
    IF F$="" then wait else return

[save]
    gosub [file]
    open F$ for output as #2
    if rand=1 then goto [one]
    #2 "*** THESE ARE ";word;" TRUE ANGRAMS WITH ANSWERS BELOW ***"
    check$=""
    for n = 0 to word
        check$=check$+t$(n)+" "
        if len(check$)>80 then #2 check$ : check$=""
    next n : #2 check$ : #2 b$ 
[one]  #2 info$ : check$=""
    for n = 0 to word
        check$=check$+new$(n)+" "
        if len(check$)>80 then #2 check$ : check$=""
    next n : #2 check$ 
[done] close #2
    notice "FILE " + F$ + " SAVED."
    close #a : goto [start]

[again] close #a : goto [start]

[quit] close #a : end

[vdat] ' THE VOWELS
    data A,E,I,O,U
    end