Click above to get retro games delivered to your door ever month!

   * PROGRAM...: SHOW1.PRG
   * AUTHOR....: John A. Reesman
   * ..........: Index Applications Incorporated
   * ..........: 8546 Broadway, Suite 208
   * ..........: San Antonio, TX  78217 USA
   * ..........: (210) 822-4818
   * DATE......: 07/25/93
   * NOTICE....: Copyright 1989-1993 by Index Applications Incorporated
   * NOTES.....: Demonstration program for CFTS routines
   * ..........: This program is a simple demostration intended to show
   * ..........: the basic use of CFTS functions.
   
   parameters NOCOLOR
   
   *********************************************************
   * GLOBAL variables
   *********************************************************
   
   private IABUFF,PREC,STAND_CLR,START_CLR
   private OPENMODE,VERTYPE,VAND,VBEG,VEND,VONE
   private IAFILE,XHANDLE
   
   *********************************************************
   * eof GLOBAL variables
   *********************************************************
   
   *********************************************************
   * GLOBAL initialization
   *********************************************************
   
   if pcount() = 1         && run in b/w regardless of video type
   
      NOCOLOR = if( upper( NOCOLOR ) = 'M', .t., .f. )
   
   else
   
      NOCOLOR = .f.
   
   endif
   
   VBEG = 1                && verify at begining of string only
   VEND = 2                && verify at end of string only
   VAND = 3                && verify all tokens in target
   VONE = 4                && don't tokenize target
   
   VERTYPE = VAND          && default verify type
   IAFILE = 'Show1.ia'     && name of our CFTS index file
   IABUFF = 10             && size of our CFTS internal buffer
   OPENMODE = .t.          && open in exclusive mode
   
   set scoreboard off
   set deleted off
   set wrap on
   set exclusive on
   
   if iscolor() .and. ! NOCOLOR        && establish our color scheme
   
      STAND_CLR   =  'W+/B,N/W,,,W+/B'
   
   else
   
      STAND_CLR   =  'W/N,N/W,,,W/N'
   
   endif
   
   START_CLR = setcolor( STAND_CLR )   && save original screen colors
   
   select 0
   
   fspec = 'show.dbf'                  && open the test file
   
   if net_use( fspec, .t., .5 )
   
       if ! file( IAFILE )
   
           tone( 260, 2 )
   
           ans = 'Y'
   
           @ row()+1,00 say IAFILE+' does not exist. Create? (y/n)';
               get ans picture '!' valid if( ans $ 'YN', .t., .f. )
   
           read
           clear gets
   
           if ans != 'Y'
   
               close databases
               quit
   
           endif
   
           XHANDLE = cfts_index( IAFILE , IABUFF, 'iastring', OPENMODE )
   
       else
   
           XHANDLE = cfts_open( IAFILE, IABUFF, OPENMODE )
   
       endif
   
   else
   
       ? 'error: unable to open ' + fspec
       quit
   
   endif
   
   if iscolor() .and. ! NOCOLOR        && establish our color scheme

       STAND_CLR   =  'W+/B,N/W,,,W+/B'

   else

       STAND_CLR   =  'W/N,N/W,,,W/N'

   endif

   START_CLR = setcolor( STAND_CLR )   && save original screen colors
                                       && and set new color
   clear screen
   
   *********************************************************
   * eof GLOBAL initialization
   *********************************************************
   
   *********************************************************
   * Main Loop
   *********************************************************
   
   do while .t.
   
       searchstr = space( 120 )

       @ 24,00 say 'Find:' get searchstr picture '@S72'
       read
       clear gets

       if lastkey() != 27 .and. !empty( searchstr )   && didn't ESCAPE

           clear screen            && set up for searching
           cfts_set( XHANDLE, trim( searchstr ) )

           ans = cfts_next( XHANDLE )  && get a 'hit' from the index

           do while ans > 0    && verify all hits until we're done

               goto ans        && CFTS returns the .dbf record number
                               && Cfts_Veri() offers several options,
                               && in this case we're "ANDing" all tokens
                               && in the search string

            if cfts_veri(XHANDLE,trim(show->title),trim(searchstr),VERTYPE)=1

               if row() >= 24  && it's not a fancy screen, but let's clear it
                               && when we've used up what we've got
                  clear screen

               endif

               @ row(), 00 say trim( show->title )
               wait

            endif

               ans = cfts_next( XHANDLE )  && get the next hit

           enddo

       else

           if lastkey() = 27

               exit          && user pressed ESCAPE, exit from loop

           endif

       endif
   
   enddo
   
   close databases
   
   cfts_close( XHANDLE )
   
   setcolor( START_CLR )      && restore our original screen colors
   
   quit
   
   *********************************************************
   * eof Main Loop
   *********************************************************
   
   *********************************************************
   * IASTRING function
   *********************************************************
   
   function iastring

   && the Cfts_Index() UDF, in CFTS87.PRG, requires as its third 
   && parameter the name of a function that returns a string comprising 
   && the fields that are to be included in the CFTS index. The name of 
   && the function is passed as a string to Cfts_Index() where it is 
   && "macro-ized" and executed within Cfts_Index().  This is not 
   && a unique feature of Fast Text Search; rather we are just exploiting 
   && a rather powerful feature of Clipper. The CFTS5.PRG file on the 
   && distribution diskette uses code blocks for this operation.
   
   return( trim( show->title ) )
   
   * eof function iastring
   
   *********************************************************
   * eof IASTRING function
   *********************************************************