[futurebasic] Re: Try this

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : July 2003 : Group Archive : Group : All Groups

From: Scott Spencer <sj3@...>
Date: Tue, 15 Jul 2003 21:24:11 -0700
Ken.

Works with this.

Otherwise, I think it was my fault.  I have "Use only DIMensioned 
Variables" turned on, and I dimmed your "defaultVol" in

fStr = files$( _fSave, "Save As...", "Word index", defaultVol )

as an FSSpec.  Dimming it as an Int made it work just fine.

Thanks much -- a pretty cool (and useful) app.

----
Scott Spencer
SJ3 Solutions
sj3@...


On Tuesday, July 15, 2003, at 08:59  PM, Ken Shmidheiser wrote:

> Scott:
>
> Try this. I have also attached a compiled application.
>
> Ken
>
>
> // For older systems as per Robert Purves
> dim system 20000000
>
> output file "Ken's Counter b04"
>
> gFBUseNavServices = _zTrue
>
> begin record MicroSecRecord
> dim as unsigned long   microSecHi, microSecLo
> end record
>
> Toolbox Microseconds( long ) `0xA193,0x225F,0x22C8,0x2280
>
> local fn DeltaMilliSeconds( oldMS as ptr to MicroSecRecord )
> // difference between old microseconds and present;
> // convert to milliseconds
> dim nowMS as MicroSecRecord
> fn Microseconds( nowMS )
> end fn = (nowMS.microSecLo - oldMS.microSecLo)/1000
>
> begin globals
> dim dynamic splitArray( _maxLong ) as STR63
> dim dynamic     arrayB( _maxLong ) as str63
> dim as container gC
> end globals
>
> gDeletePunctuation = _false
>
> local fn BuildMenus
>
> apple menu "Ken's Kounter"
>
> menu 1, 0, _enable, "File"
> menu 1, 1, _enable, "Open file to parse..."
>
> gFBEditSelectAll = _zTrue
> edit menu 2
>
> end fn
>
> local fn AboutWindow
> dim as str255 infoStr
> dim as rect   r
>
> setrect( r, 0, 0, 250, 190 )
> appearance Window -2, "About Ken's Counter", @r,¬
> _kDocumentWindowClass, _kWindowCloseBoxAttribute
> def SetWindowBackground( _kThemeActiveDialogBackgroundBrush, _zTrue)
>
> text _sysFont, 16, _boldBit%, _srcCopy
> color _zRed
> setrect( r, 20, 5, 230, 65 )
> edit field -2,, @r, _statNoFramed,_centerJust
>
> infoStr = chr$(13) + "Ken's Kounter b04" + chr$(13)
>
> edit$(2) = infoStr
>
> text _applFont, 12, 0,_srcCopy
> setrect( r, 20, 80, 230, 175 )
> color _zBlack
> edit field -3,, @r, _statNoFramed,_centerJust
>
> infoStr =  + "Coded in FB^3 by Ken Shmidheiser"¬
> + chr$(13) + "Somerset, KY" + chr$(13) + "July 13, 2003"¬
> + chr$(13) + ¬
> + chr$(13) + "Count & index words/expressions in a text file"
>
> edit$(3) = infoStr
>
> def windowreposition( 2, 1,¬
> _kWindowAlertPositionOnParentWindowScreen )
>
> window 2
>
> end fn
>
> local fn BuildWindow
> dim as rect r
>
> setrect( r, 0, 0 , 400, 155 )
> appearance Window -1, "Ken's Kounter", @r,¬
> _kDocumentWindowClass, _kWindowStandardFloatingAttributes
>
> def SetWindowBackground( _kThemeActiveDialogBackgroundBrush,_zTrue)
>
> text _applFont, 12
> setrect( r, 20, 20, 380, 60)
> edit field 1,"Click button to select text file to parse...",¬
> @r,_framed,_centerJust
>
> text _applFont, 10
> setrect( r, 183, 100, 380, 115)
> edit field 2,"",@r,_statNoFramed,_leftJust
>
> setrect( r, 320, 120, 380, 140 )
> button 1,1,"Quit",@r,_shadow
>
> setrect( r, 180, 120, 310, 140 )
> button 2,1,"Open text file",@r,_push
>
> setrect( r, 20, 75, 380, 90 )
> appearance button 3, _activeBtn, 0, 0, 100,"",¬
> @r, _kControlProgressBarProc
>
> setrect( r, 20, 100, 160, 115 )
> APPEARANCE BUTTON 4,  _activeBtn,¬
>  _kControlCheckBoxUncheckedValue,¬
> 0, _kControlCheckBoxCheckedValue,¬
>              "Strip punctuation",¬
>         @r, _kControlCheckBoxProc
>
> setrect( r, 20, 120, 160, 135 )
> APPEARANCE BUTTON 5,  _activeBtn,¬
>  _kControlCheckBoxUncheckedValue,¬
> 0, _kControlCheckBoxCheckedValue,¬
>              "Uppercase results",¬
>         @r, _kControlCheckBoxProc
>
> edit field 0
>
> def windowreposition( 1, 0, _kWindowAlertPositionOnMainScreen )
>
> window 1
>
> end fn
>
> local fn Split( @CPtr as ptr, splitChar as str15 )
> dim as pointer startOfDataPtr, endOfDataPtr, itemPtr
> dim as pointer p1, p2
> dim as long    size, splits
>
> if CPtr.nil& = _nil then exit fn
>
> startOfDataPtr = [CPtr.nil&]
> endOfDataPtr   = startOfDataPtr + Fn GetHandleSize(CPtr.nil&)
> Long If endOfDataPtr > startOfDataPtr
> splits = 0
> splitArray( _maxLong ) = ""
>
> for p1 = startOfDataPtr to endOfDataPtr
> itemPtr = @splitArray(splits)
> p2      = itemPtr
> while p1.0`` != splitChar[1] and p1 < endOfDataPtr
> p2++
> p2.0`` = p1.0``
> p1++
> wend
> size =  p2 - itemPtr
> long if size < sizeof(splitArray(0))
> itemPtr.0`` = size
> xelse
> itemPtr.0`` = sizeof(splitArray(0)) - 1
> end if
> splits++
> next
>
> compress dynamic splitArray
> end if
>
> end fn = splits
>
> local fn QuickSort( loIn as long, hiIn as long )
> dim as long   lo, hi
> dim as str255 mid, t
>
> lo = loIn : hi = hiIn
> long if( hiIn > loIn)
> mid = splitArray((loIn + hiIn) /2)
> while (lo <= hi)
> while ((lo < hiIn) and (splitArray(lo) < mid)) : lo++ : wend
> while ((hi > loIn) and (splitArray(hi) > mid)) : hi-- : wend
> long if (lo <= hi)
> swap splitArray(lo), splitArray(hi) : lo++ : hi--
> end if
> wend
> if (loIn <  hi) then fn QuickSort( loIn, hi )
> if (lo <  hiIn) then fn QuickSort( lo, hiIn )
> end If
>
> end fn
>
> local fn FindSortedArrayDuplicates( lastElement as long )
> dim as long    i, y, counter, increment
> dim as str255  aStr, bStr, cStr, tabStr
> dim as boolean start
>
> aStr = "" : bStr = "" : cStr = ""
> y = 0 : counter = 1
>
> for i = 0 to lastElement
>
> aStr = splitArray( i )
> bStr = splitArray( i + 1 )
>
> if aStr = "" then goto "next"// exit for
>
> long if aStr = bStr
> counter++
> goto "next"
> xelse
> long if counter < 10
> tabStr = chr$(9) + chr$(9)
> xelse
> tabStr = chr$(9)
> end if
> cStr = str$( counter ) + "x" + tabStr + splitArray( i )
> counter = 1
> end if
>
> arrayB(y) = cStr
> y++
>
> "next"
>
> next i
>
> kill dynamic splitArray
> compress dynamic arrayB
>
> end fn = y
>
> //  Read contents of selected file into a handle
> local fn LoadFileIntoHandle( fileStr as str255, vol as int )
> dim as handle @ fileH
> dim as long     fileLen
> dim as OSErr    err
>
> open "I", #1, fileStr, ,vol
>
> fileLen = lof(1, 1)
>   fileH = fn newhandleclear( fileLen )
>     err = syserror
>
> long if fileH != 0 and err == 0
> read file #1, [fileH], fileLen
> end if
> close #1
>
> end fn = fileH
>
> // Open file, load text into container
> local fn OpenFileToParse
> dim as handle  @ fileH
> dim as integer @ vRefNum
> dim as str255    fileNameStr
> dim as MicroSecRecord  startMicroS
>
> fileNameStr = files$( _fOpen, "TEXT", "Open file to parse", vRefNum )
> long if fileNameStr = ""
> exit fn
> xelse
> fileH = FN LoadFileIntoHandle( fileNameStr, vRefNum )
> end if
>
> // If file handle is valid, load its contents into container
> long if fileH != 0
> edit$(2) = ""
> fn Microseconds( startMicroS )// Begin timer
> gc = ""// Initialize container for strings
> gC = &fileH// Load text handle into container
> def disposeh( fileH )// Dispose of handle; no longer needed
> xelse
> beep
> end if
>
> end fn
>
> local fn ParseContainer( punctuation as boolean )
> dim as handle          repH
> dim as integer        count
>
> repH = Fn NewHandle(0)
> Long If repH
>
> if punctuation = _true then goto "killPunctuation"
> edit$( 1 ) = "Parsing punctuation..." + chr$(13)
> // kill all periods in container
> count = fn ReplaceText( [@gC], repH, "." )
> // kill all commas in container
> count = fn ReplaceText( [@gC], repH, "," )
> // kill all colons in container
> count = fn ReplaceText( [@gC], repH, ": " )
> // kill all semicolons in container
> count = fn ReplaceText( [@gC], repH, ";" )
> // kill all exclamation points in container
> count = fn ReplaceText( [@gC], repH, "!" )
> // kill all question marks in container
> count = fn ReplaceText( [@gC], repH, "?" )
> // kill all single quotes in container
> count = fn ReplaceText( [@gC], repH, "'" )
> // kill all double quotes in container
> count = fn ReplaceText( [@gC], repH, chr$(34) )
> // kill all left parens in container
> count = fn ReplaceText( [@gC], repH, "(" )
> // kill all right parens in container
> count = fn ReplaceText( [@gC], repH, ")" )
> // kill all left brace in container
> count = fn ReplaceText( [@gC], repH, "{" )
> // kill all right brace in container
> count = fn ReplaceText( [@gC], repH, "}" )
> // kill all left bracket in container
> count = fn ReplaceText( [@gC], repH, "[" )
> // kill all right bracket in container
> count = fn ReplaceText( [@gC], repH, "]" )
> // kill all double dashes in container
> count = fn ReplaceText( [@gC], repH, "--" )
> appearance button 3,,10
>
> "killPunctuation"
>
> edit$( 1 ) = "Converting tabs,¬
> feeds and returns to spaces..." + chr$(13)
>
> SetHandleSize( repH, 1 )
> Long If Fn MemError = _noErr
> repH..0`` = _" "
> // convert tabs to spaces
> count = fn ReplaceText( [@gC], repH, chr$( 9) )
> appearance button 3,,20
> // convert all line feeds to spaces
> count = fn ReplaceText( [@gC], repH, chr$(10) )
> appearance button 3,,40
> // convert carriage returns to spaces
> count = fn ReplaceText( [@gC], repH, chr$(13) )
> appearance button 3,,60
> // Find and replace any occurences of multiple spaces
> count = fn ReplaceText( [@gC], repH, "  " )
> End If
>
> DisposeHandle( repH )
> end if
>
> end fn
>
> local fn WriteArrayToDisk( lastElement as long )
> dim as str255          fStr
> dim as long            i
> dim as MicroSecRecord  startMicroS
> dim as double          elapsedTime
>
> route _toBuffer + 2
>
> for i = 0 to lastElement
> print arrayB( i )
> next i
>
> route _toScreen
>
> kill dynamic arrayB
> elapsedTime = fn DeltaMilliSeconds( startMicroS )
> edit$(2) = "Elapsed time:" + str$( abs(elapsedTime/100000)) + " 
> seconds"
>
> long if gFBBuffer(2)
> def open "TEXTR*ch"
> fStr = files$( _fSave, "Save As...", "Word index", defaultVol )
> hlock( gFBBuffer(2) )
> open "O", 1, fStr, 1, defaultVol
> write file 1, [gFBBuffer(2)], fn GetHandleSize( gFBBuffer(2) )
> close 1
> hunlock( gFBBuffer(2) )
> def disposeh( gFBBuffer(2) )
> end if
>
> end fn
>
> local fn SplitAndSortArray
> dim as long lastElement, y, i
>
> edit$(1) = "Creating array of individual ¬
> words and/or expressions..."
> // Build split array with space as delimiter
> lastElement = FN Split( gC, " " )
> appearance button 3,,80
> // Empty container, no longer needed
> gC = ""
>
> edit$(1) = "Sorting word list..."
> // Sort the split array
> fn QuickSort( 0, lastElement )
> appearance button 3,,90
>
> edit$(1) = "Counting and indexing duplicate words..."
> // Find, count & remove duplicates in array
> y = fn FindSortedArrayDuplicates( lastElement )
> appearance button 3,,95
>
> edit$(1) = "Parsed file ready to save"
> fn WriteArrayToDisk( y )
> appearance button 3,,100
>
> edit$(1) = "File contained" + str$(y)¬
> + " individual words and/or expressions. Click quit to end."
>
> end fn
>
> local fn DoCheckbox( btnId as long )
> dim as handle  btnH
> dim as integer value
>
>  btnH = button&( btnID )
> value = fn getcontrolvalue ( btnH )
>
> long if value = 1
> setcontrolvalue ( btnH, 0 )
> xelse
> setcontrolvalue ( btnH, 1 )
> end if
>
> end fn
>
> local fn CaseAndPunctuation( bnt4 as long, btn5 as long )
> dim as handle  btnH
> dim as integer value
>
>  btnH = button&( bnt4 )
> value = fn getcontrolvalue ( btnH )
>
> long if value = 1
> fn ParseContainer( _false )
> xelse
> fn ParseContainer( _true )
> end if
>
>  btnH = button&( btn5 )
> value = fn getcontrolvalue ( btnH )
>
> long if value = 1
> edit$(1) = "Uppercasing file"
> appearance button 3,,5
> gC = ucase$$( gC)
> xelse
> end if
>
> end fn
>
> local fn DoDialog
> dim as long evnt, id
>
> evnt = dialog(0)
> id = dialog(evnt)
>
> select case( evnt )
> case _wndClose
> select( id )
> case 1 :  gFBQuit = _zTrue
> case 2 : window close 2
> end select
> case _btnClick
> select( id )
> case 1 :  gFBQuit = _zTrue
> case 2
> appearance button 3,,0
> fn OpenFileToParse
> fn CaseAndPunctuation( 4, 5)
> fn SplitAndSortArray
> case 4
> fn DoCheckBox( 4 )
> case 5
> fn DoCheckBox( 5 )
> end select
> end select
>
> end fn
>
> local fn DoMenu
> dim as long menuID, itemID
>
> menuID = menu(_menuID)
> itemID = menu(_itemID)
>
> select case( menuID )
> case _applemenu
> select( itemID )
> case 1 : fn AboutWindow
> end select
> case 1
> select( itemID )
> case 1
> menu
> appearance button 3,,0
> fn OpenFileToParse
> fn CaseAndPunctuation( 4, 5 )
> fn SplitAndSortArray
> appearance button 3,,0
> end select
> end select
> menu
>
> end fn
>
> on dialog fn DoDialog
> on menu fn DoMenu
>
> fn BuildMenus
> fn BuildWindow
>
> do
> handleevents
> until gFBQuit
> end<Ken's Counter b04.sit>
----
Scott Spencer
SJ3 Solutions
sj3@...