Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : GRMSPELL.ZIP
Filename : SPELL.PRG

 
Output of file : SPELL.PRG contained in archive : GRMSPELL.ZIP
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ THE GRUMPFISH SPELLCHECKER ³
*³ For Clipper Summer '87 ³
*³ ³
*³ Released into the public domain ³
*³ ³
*³ Grumpfish, Inc. ³
*³ Post Office Box 17761 ³
*³ Salem, Oregon 97305 ³
*³ Tel (503) 588-1815 ³
*³ Fax (503) 588-1980 ³
*³ BBS (503) 588-7572 ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

** ADDED "SKIP ALL" OPTION

*
* SPELLIT(): The heart of the Grumpfish Spellchecker
*
* Syntax: Spellit(, , , ,
* , , )
*
* = Character string, memo field, or text file
* to be spell-checked. Character or memo-type
* variables MUST NOT be enclosed in quotes.
* Names of text files MUST be enclosed in quotes.
*
* Optional Parameters:
*
* , , , represent the coordinates
* to be used for displaying the spell-checked text. If these
* parameters are not passed, the text will be displayed on
* the entire screen (0, 0, 24, 79). Either pass all or none
* of these parameters.
*
* is a character expression representing the
* color to use for displaying the text. The default is
* high intensity white on black (+W/N).
*
* is a character expression representing the
* color to use for the flagged (highlighted) text. The
* default is inverse video (N/W).
*
FUNCTION spellit
PARAMETERS file_hold, top_row, left_col, bot_row, right_col, tcolor, hilite

PRIVATE oldwk_area, old_scrn, old_color, old_row, old_col, start_sp, ;
_space, _word, hold, start_top, crlf, mfirstchar, mlastchar, ;
wait_left, wait_right, waitscrn, czech_msg, mainloop, word_count, ;
wordcopy, gotthisone, skip_all[75], skip_ctr

*--> save previous work area, screen, color setting, and cursor position
oldwk_area = SELECT()
old_color = SETCOLOR()
old_row = ROW()
old_col = COL()
SAVE SCREEN TO old_scrn

*--> establish full screen as view area if no coordinates were passed
IF PCOUNT() = 1
top_row = 0
left_col = 0
bot_row = 24
right_col = 79
ENDIF

*--> establish colors for text and highlight bar if not passed as parameters
tcolor = IF(PCOUNT() < 6, '+W/N', tcolor)
hilite = IF(PCOUNT() < 7, 'I', hilite)

*--> initialize word counter
word_count = 0

*--> initialize counter for SKIP_ALL array (maximum: 75 elements)
skip_ctr = 1

czech_msg = 'Checking words...' && an irresistible pun if I ever saw one

*--> see if memofield/character string or text file was passed
IF FILE(file_hold)
file_hold = TRIM(MEMOREAD(file_hold))
ELSEIF TYPE('file_hold') = 'M' .OR. TYPE('file_hold') = 'C'
*--> first, use MEMOLINE() to strip out all soft carriage returns
*--> (CHR(141)/CHR(10) because they wreak havoc on the highlight bar
*--> positioning in any row other than the first
*-->
*--> Note that we can only do this for strings/memos under 255 characters
*--> in length, because this is the maximum imposed by MEMOLINE()
*--> For anything longer than that, we must use HARDCR() to convert
*--> the soft carriage returns (CHR(141)) to hard ones (CHR(13))
IF LEN(file_hold) < 255
file_hold = TRIM(MEMOLINE(file_hold, LEN(file_hold), 1))
ELSE
file_hold = HARDCR(file_hold)
ENDIF
ELSE
RETURN ('')
ENDIF
start_top = 1

SELECT 0
USE dict

IF ! file('dict.ntx') .OR. ! file('dict2.ntx')
Wait_msg('Indexing Dictionary...')
INDEX ON word TO dict
INDEX ON SOUNDEX(word) TO dict2
Wait_msg()
ENDIF
SET INDEX TO dict, dict2

Wait_msg(czech_msg)
mainloop = .T.
mline = MLCOUNT(file_hold,(right_col-left_col))

FOR z = 1 TO mline
start_sp = 1
hold = MEMOLINE(file_hold,(right_col-left_col),z)

DO WHILE mainloop
STORE 0 TO mfirstchar, mlastchar, crlf, wordcopy
_space = AT(CHR(32), hold)
_word = SUBSTR(hold, start_sp, _space - start_sp)

*--> increment word counter
word_count = word_count + 1

*--> screen out one-character and common words
IF LEN(_word) > 0 .AND. ! UPPER(_word) $ "AN AM AS AT BE " + ;
"BY DO GO HE IF IN IT IS ME MR MY NO OF " + ;
"ON OR SO TO UP US WE"
GO TOP
*** first see if the word is in our SKIP_ALL array
IF ASCAN(skip_all, UPPER(_word)) = 0
SEEK UPPER(_word)
IF ! FOUND() .OR. UPPER(_word) != TRIM(WORD)
*--> if word contains unprintable chars, must strip 'em out
IF GarbageIn()
***-> first make safety copy of word
wordcopy = _word
_word = GarbageOut()
IF LEN(_word) > 0
SEEK UPPER(_word)
gotthisone = (FOUND() .AND. UPPER(_word) == TRIM(WORD))
ELSE
** word was all unprintable and thus is now empty
** so there is no point looking for it
gotthisone = .T.
ENDIF
ELSE
gotthisone = .F.
ENDIF
IF ! gotthisone
Wait_msg()
DO correct WITH TextViewer(.T.)
Wait_msg(czech_msg)
ENDIF
ENDIF
ENDIF
ENDIF

*--> find next space [CHR(32)] in this line - if none, go to next line
start_sp = _space
DO WHILE SUBSTR(hold, start_sp, 1) = CHR(32)
hold = SUBSTR(hold, 1, start_sp-1) + CHR(255) + SUBSTR(hold, start_sp+1)
start_sp = start_sp + 1
ENDDO
IF start_sp = LEN(hold) + 1 .OR. start_sp = LEN(hold) .OR. ;
AT( CHR(32), hold) = 0
EXIT
ENDIF
ENDDO
NEXT
USE
TextViewer()
Wait_msg('Number of words checked ' + LTRIM(STR(word_count)))
inkey(0)
*--> restore rest of previous environment
RESTORE SCREEN FROM old_scrn
SELECT(oldwk_area)
SETCOLOR(old_color)
@ old_row, old_col SAY ''
RETURN (file_hold)


*-----------------------------------------------------------------
*
* CORRECT: found goof - display it and allow user to correct it
*
*-----------------------------------------------------------------
PROCEDURE correct
PARAM word_pos
PRIVATE buf_spl, old_color, new_word, showem, buf_spl2, corrboxtop, corr_choice
old_color = SETCOLOR('W/B')
corrboxtop = IF(word_pos > 10, 00, 13) && for 'smart' positioning of box
buf_spl = SAVESCREEN(corrboxtop, 20, corrboxtop + 11, 61)
msg_box(corrboxtop, 20, corrboxtop + 10, 59)
SETCOLOR('*GR+/B')
@ corrboxtop + 1, INT((80 - LEN(_word)) / 2) SAY _word
SETCOLOR('W/B')
@ corrboxtop + 2, 25 SAY 'Word not found in dictionary'

DO WHILE .T.
@ corrboxtop + 4,32 PROMPT '1 - See Choices'
@ ROW() + 1,32 PROMPT '2 - Edit Word '
@ ROW() + 1,32 PROMPT '3 - Add Word '
@ ROW() + 1,32 PROMPT '4 - Skip Word '
@ ROW() + 1,32 PROMPT '5 - Skip All '
@ ROW() + 1,32 PROMPT '6 - Quit '
MENU TO corr_choice

DO CASE

CASE corr_choice = 1
SET ORDER TO 2
SEEK SOUNDEX(UPPER(_word))
showem = .F.
IF FOUND()
PRIVATE choices[20], xx, matches
numrecs = 0
DO WHILE SOUNDEX(word) == SOUNDEX(UPPER(_word)) .AND. numrecs < 21
matches = 0
*--> first compare lengths of misspelled word vs. prospective choice
*--> if there is a difference of more than 2 characters, ditch this one
IF ABS(LEN(TRIM(word)) - LEN(_word)) < 3
*--> now loop through each character of this prospective word and count matches
*--> against the characters of the misspelled word
FOR xx = 1 TO LEN(TRIM(word))
matches = matches + IF(UPPER(SUBSTR(word, xx, 1)) $ ;
UPPER(_word), 1, 0)
NEXT
*--> add word to array CHOICES only if there are enough matching characters
*--> for example, if misspelled word has 5 characters, there must be at least
*--> 3 matching characters for us to use it - this criteria subject to change
IF matches > LEN(_word) - 2
numrecs = numrecs + 1
choices[numrecs] = word
ENDIF
ENDIF
SKIP
ENDDO
showem = (numrecs > 0) && if numrecs=0, we must bypass the display
ENDIF
IF showem
boxtop = MAX(corrboxtop + 7 - numrecs, corrboxtop)

buf_spl2 = SAVESCREEN(boxtop, 30, corrboxtop + 9, 51)
SETCOLOR('+W/BR')
msg_box(boxtop, 30, corrboxtop + 8, 49)
ele = ACHOICE(boxtop + 1, 31, corrboxtop + 7, 48, choices)
RESTSCREEN(boxtop, 30, corrboxtop + 9, 51, buf_spl2)
SETCOLOR('W/B')
SET ORDER TO 1
IF ele > 0
new_word = TRIM(choices[ele])
*--> determine upper/lower case of new word based on old word
IF ISLOWER(_word)
new_word = LOWER(new_word)
ELSE
IF ! ISUPPER(SUBSTR(_word, 2, 1))
new_word = UPPER(SUBSTR(new_word,1,1)) + ;
LOWER(SUBSTR(new_word, 2, LEN(TRIM(new_word))))
ENDIF
ENDIF
Now_Fix_It()
_space = _space - (LEN(_word) - LEN(new_word))
EXIT
ENDIF
ELSE
wait_msg('Sorry, no alternatives found')
inkey(5)
wait_msg()
ENDIF
SET ORDER TO 1

CASE corr_choice = 2
** limit length of editable word to 32 characters
new_word = SUBSTR(_word + SPACE(LEN(_word)), 1, 32)
buf_spl2 = SAVESCREEN(corrboxtop + 5, 15, corrboxtop + 8, 66)
SETCOLOR('+W/BG')
msg_box(corrboxtop + 5, 15, corrboxtop + 7, 64)
@ corrboxtop + 6, 17 SAY 'Enter word => ' GET new_word
READ
RESTSCREEN(corrboxtop + 5, 15, corrboxtop + 8, 66, buf_spl2)
SETCOLOR('W/B')
IF LASTKEY() != 27
new_word = TRIM(new_word)
Now_Fix_It()
EXIT
ENDIF

CASE corr_choice = 3
APPE BLANK
REPLACE word WITH UPPER(_word)
EXIT

CASE corr_choice = 4
EXIT

CASE corr_choice = 5
*** ensure that we have not already max'ed out the SKIP_ALL array
*** if you need more than 75 elements, modify line 45 above
IF skip_ctr < 75
skip_all[skip_ctr] = UPPER(IF(TYPE('wordcopy') = 'C', ;
wordcopy, _word))
skip_ctr = skip_ctr + 1
ENDIF
*** you may wish to give the user an error message if this array
*** is max'ed out, but we'll leave that up to your discretion
EXIT

CASE corr_choice = 6
mainloop = .F.
z = mline
EXIT
ENDCASE
ENDDO
RESTSCREEN(corrboxtop, 20, corrboxtop + 10, 61, buf_spl)
SETCOLOR(old_color)
RETURN


*----------------------------------------------
*
* MSG_BOX(): draw box with transparent shadow
*
*----------------------------------------------
FUNCTION msg_box
PARAM boxtop, boxleft, boxbott, boxright
Setattr(boxtop + 1, boxright + 1, boxbott, boxright + 2, 8)
Setattr(boxbott + 1, boxleft + 2, boxbott + 1, boxright + 2, 8)
@ boxtop, boxleft, boxbott, boxright BOX 'ÖÄ·º½ÄÓº '
RETURN ('')


*-------------------------------------------------------
*
* TEXTVIEWER(): display text and flag misspelled word
*
*-------------------------------------------------------
FUNCTION textviewer
PARAMETER hilite_it
PRIVATE linelength
linelength = (bot_row - top_row ) + start_top
start_top = IF (start_top <= z .AND. z <= linelength, start_top, z)
SETCOLOR(tcolor)
MEMOEDIT(file_hold, top_row, left_col, bot_row, right_col, .F., .F., ;
(right_col - left_col), 4, start_top)
*--> if a parameter was passed, must highlight misspelled word
IF PCOUNT() = 1
SETCOLOR(hilite)
@ top_row + (z - start_top), left_col + start_sp - 1 SAY _word
SETCOLOR(tcolor)
ENDIF
RETURN(top_row + (z - start_top))


*-----------------------------------------------------
*
* WAIT_MSG(): display user feedback box
*
*-----------------------------------------------------
FUNCTION Wait_msg
PARAM msg
PRIVATE old_color
*** I save these parameters so that they can be utilized by waitoff()
*** to properly restore the screen region taken up by the message box
IF PCOUNT()=0 && if no parameter passed, restore screen
RESTSCREEN(11, wait_left, 14, wait_right + 2, waitscrn)
ELSE
old_color = SETCOLOR('+GR/N')
wait_left = INT(74 - LEN(msg)) / 2
wait_right = 79 - wait_left
waitscrn = SAVESCREEN(11, wait_left, 14, wait_right + 2)
Msg_box(11, wait_left, 13, wait_right)
SETCOLOR('+GR*/N')
@12, wait_left + 3 SAY msg
SETCOLOR(old_color)
ENDIF
RETURN('')


*--------------------------------------------
*
* NOW_FIX_IT(): replace word in the string
*
*--------------------------------------------
FUNCTION now_fix_it
*--> if there were unprintable characters at the beginning or end of the
*--> original word, we will now insert them into the new word
new_word = IF(TYPE('mfirstchar') = 'C', mfirstchar, '') + new_word + ;
IF(TYPE('mlastchar') = 'C', mlastchar, '') + ;
IF(crlf > 0, CHR(13)+CHR(10), '')

*--> If we made a safety copy of the original word, switch to it now
_word = IF(TYPE('wordcopy') = 'C', wordcopy, _word)

*--> before we do the replacement, we must insert something in front of
*--> the word so that the STRTRAN() function will not do something stupid
*--> like substitute an occurrence of this word within a larger word
*--> (e.g., "RENT" as part of "CURRENT"). If the word is at the beginning
*--> of a line, we will preface it with a linefeed (CHR(10)); otherwise,
*--> we will use either CHR(32) (in FILE_HOLD) or CHR(255) in the
*--> temporary line (HOLD) because we are replacing CHR(32)s with CHR(255)s
*--> therein.
file_hold = STRTRAN(file_hold, IF(start_sp > 1, CHR(32), CHR(10)) + _word, ;
IF(start_sp > 1, CHR(32), CHR(10)) + new_word)
hold = STRTRAN(hold, IF(start_sp > 1, CHR(255), '') + _word, ;
IF(start_sp > 1, CHR(255), '') + new_word)
RETURN('')


*-------------------------------------------------------------
*
* GARBAGEIN(): check for unprintable characters in this word
*
*--------------------------------------------------------------
FUNCTION garbagein
PRIVATE mchar, ret_val, xx
ret_val = .F.
FOR xx = 1 TO LEN(_word)
mchar = ASC(SUBSTR(_word, xx, 1))
IF mchar < 65 .OR. (mchar > 90 .AND. mchar < 97) .OR. mchar > 122
ret_val = .T.
EXIT
ENDIF
NEXT
RETURN (ret_val)


*--------------------------------------------------------------
*
* GARBAGEOUT(): strip unprintable characters out of this word
*
*---------------------------------------------------------------
FUNCTION garbageout
PRIVATE mchar, ret_val, xx
ret_val = ''
*--> first check to see if CR/LF is in this word -- it would be at the end
crlf = AT(CHR(13) + CHR(10), _word)
** now loop through word and strip out all unprintable (@*!@^$%^&) characters
FOR xx = 1 TO LEN(_word)
mchar = ASC(SUBSTR(_word, xx, 1))
*--> if printable
IF (mchar > 64 .AND. mchar < 91) .OR. (mchar > 96 .AND. mchar < 123)
ret_val = ret_val + CHR(mchar)
ELSE
*--> if unprintable
DO CASE
*--> if first char, save for insertion if word is later replaced
CASE xx = 1 && is this the first character ??
mfirstchar = CHR(mchar)
*--> if last character (and not part of CR/LF), save for insertion
CASE xx = LEN(_word) .AND. crlf = 0
mlastchar = CHR(mchar)
ENDCASE
ENDIF
NEXT
RETURN (ret_val)


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : GRMSPELL.ZIP
Filename : SPELL.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/