Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Word Scrambler (kind of) Challenge
#2
Code:
'returns a String containing all the ASCII characters that are NOT in letters$
'(only needed for initialization)
DECLARE FUNCTION invertchars$ (letters$)

'Reads the next "word" from s$, starting at position position%.
'Updates the position% (so you must use CALL to use this function).
'(a "word" is the longest string that can be made with the set of
'letters in letters$)
DECLARE SUB nextword (s$, letters$, position%, word$)

'Randomly mix up the word keeping the first and last letters fixed.
DECLARE FUNCTION adjust$ (word$)

'Randomly mix up the letters in the word.
DECLARE FUNCTION mix$ (word$)

'Delete a sequence of length% characters starting at index%.
DECLARE FUNCTION delmid$ (word$, index%, length%)

' ******************** INITIALIZATION ********************

'String with all the letters that are used to make words
letters$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
'The spacing between two arguments in command$ (space or tab)
spacing$ = " " + CHR$(9)

'nonletters$: String with all the letters that are NOT used to make words
'Note that this must contain all characters that are not in letters$,
'otherwise we can get an infinite loop when a character is encountered
'that is not in either one of the strings.
nonletters$ = invertchars$(letters$)
nonspacing$ = invertchars$(spacing$)

'Useful to get different mixes each time we run the program...
RANDOMIZE TIMER

'Read in the command line options from the string command$
position% = 1
CALL nextword(COMMAND$, nonspacing$, position%, infile$)
CALL nextword(COMMAND$, spacing$, position%, outfile$)
CALL nextword(COMMAND$, nonspacing$, position%, outfile$)

IF infile$ = "" OR outfile$ = "" THEN
    PRINT
    PRINT "Usage: mixer <inputfile> <outputfile>"
    PRINT
    PRINT "Mixer takes a text file as input and outputs a file where the letters of "
    PRINT "each word are randomly mixed up, keeping the first and the last letter fixed."
    PRINT "You will see that as long as the words aren't too long you can still read "
    PRINT "the text very well."
    END
END IF

' ******************** MAIN PROGRAM ********************

in% = FREEFILE
OPEN infile$ FOR INPUT AS in%
  'Read the whole file at once
  text$ = INPUT$(LOF(in%), in%)
CLOSE in%

outp% = FREEFILE
OPEN outfile$ FOR OUTPUT AS outp%

position% = 1
WHILE position% <= LEN(text$)
    'Read the next "non"word: a sequence of characters that aren't letters.
    CALL nextword(text$, nonletters$, position%, word$)
    PRINT #outp%, word$;

    'PRINT word$;

    'Read the next word and mix up the letters (except the first and the last).
    CALL nextword(text$, letters$, position%, word$)
    word$ = adjust$(word$)
    PRINT #outp%, word$;
    'PRINT word$;
WEND

CLOSE outp%

'Randomly mix up the word keeping the first and last letters fixed.
'
FUNCTION adjust$ (word$)
  IF LEN(word$) <= 2 THEN
      adjust$ = word$
  ELSE
      'Take first and last letter fixed and mix the other letters
      adjust$ = MID$(word$, 1, 1) + mix$(MID$(word$, 2, LEN(word$) - 2)) + MID$(word$, LEN(word$), 1)
  END IF
END FUNCTION

'Delete a sequence of length% characters starting at index%.
'
FUNCTION delmid$ (word$, index%, length%)
    delmid$ = MID$(word$, 1, index% - 1) + MID$(word$, index% + length%, LEN(word$) - index% - length% + 1)
END FUNCTION

'returns a String containing all the ASCII characters that are NOT in letters$
FUNCTION invertchars$ (chars$)

    FOR i% = 0 TO 255
        ch$ = CHR$(i%)
        IF INSTR(chars$, ch$) = 0 THEN nonchars$ = nonchars$ + ch$
    NEXT i%
    invertchars$ = nonchars$

END FUNCTION

'Randomly mix up the letters in the word.
'
FUNCTION mix$ (word$)
    WHILE LEN(word$) > 0
        index% = INT(RND * LEN(word$)) + 1
        result$ = result$ + MID$(word$, index%, 1)
        word$ = delmid$(word$, index%, 1)
    WEND
    mix$ = result$
END FUNCTION

'Reads the next "word" from the string s$, starting at position position%.
'Updates the position% (so you must use CALL to use this function).
'(a "word" is the longest string that can be made with the set of
'letters in letters$)
'
SUB nextword (s$, letters$, position%, word$)
    word$ = ""
    DO WHILE position% <= LEN(s$)
        ch$ = MID$(s$, position%, 1)
        IF INSTR(letters$, ch$) = 0 THEN EXIT DO
        'Character was OK, now add it and go to the next position.
        position% = position% + 1
        word$ = word$ + ch$
    LOOP
END SUB
Reply


Messages In This Thread
Word Scrambler (kind of) Challenge - by Meg - 09-21-2004, 07:38 PM
Word Scrambler (kind of) Challenge - by HQSneaker - 09-21-2004, 07:41 PM
w - by Meg - 09-21-2004, 07:44 PM
Word Scrambler (kind of) Challenge - by Meg - 09-22-2004, 01:44 AM
Yet another one... - by ToohTooh - 09-22-2004, 04:33 PM
just to reiterate... - by Meg - 09-22-2004, 06:43 PM
Word Scrambler (kind of) Challenge - by ToohTooh - 09-22-2004, 07:21 PM
Re: w - by HQSneaker - 09-22-2004, 07:49 PM
Word Scrambler (kind of) Challenge - by Z!re - 09-22-2004, 08:30 PM
Interestingly ridiculous. - by ToohTooh - 09-22-2004, 09:48 PM
Re: Interestingly ridiculous. - by HQSneaker - 09-22-2004, 10:18 PM
Word Scrambler (kind of) Challenge - by ToohTooh - 09-22-2004, 10:39 PM
Word Scrambler (kind of) Challenge - by wildcard - 09-23-2004, 12:06 AM
Word Scrambler (kind of) Challenge - by Meg - 09-23-2004, 12:12 AM
Word Scrambler (kind of) Challenge - by Z!re - 09-23-2004, 02:19 AM
Duh... - by ToohTooh - 09-25-2004, 12:23 AM
Word Scrambler (kind of) Challenge - by HQSneaker - 09-25-2004, 01:58 AM
Word Scrambler (kind of) Challenge - by wildcard - 09-25-2004, 04:28 AM
Word Scrambler (kind of) Challenge - by Meg - 09-26-2004, 09:21 AM
Word Scrambler (kind of) Challenge - by Meg - 09-28-2004, 05:57 PM
Oh, yeah, BTW - by Meg - 10-11-2004, 09:16 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)