'******************************************************
'*    Program to demonstrate the use of searching     *
'*    subroutines of unit FSearch.                    *
'* -------------------------------------------------- *
'* SAMPLE RUN:                                        *
'* (An ordered list of 16 names is given in text file *
'*  'search.dat').                                    *
'*                                                    *
'* # of items in list = 16                            *
'* What name would you like to look for? David        *
'* Linear serach for (f)irst, (a)ll, or (b)inary? f   *
'* David found at position 5.                         *
'* Try again (y/n)? y                                 *
'* What name would you like to look for? Grace        *
'* Linear serach for (f)irst, (a)ll, or (b)inary? a   *
'* Grace at position 9.                               *
'* Grace at position 10.                              *
'* Grace at position 11.                              *
'*  3 occurence(s) found.                             *
'* Try again (y/n)? y                                 *
'* What name would you like to look for? Grace        *
'* Linear serach for (f)irst, (a)ll, or (b)inary? b   *
'* Grace found at position 10.                        *
'* Try again (y/n)? n                                 *
'*                                                    *
'* -------------------------------------------------- *
'* Ref.: "Problem Solving with Fortran 90, By David R.*
'*        Brooks, Springer Verlag, 1997".             *
'*                                                    *
'*               Basic Release By J-P Moreau, Paris.  *
'*                        (www.jpmoreau.fr)           *
'******************************************************
'NOTE: for the BASIC release, the input text file
' "serach.dat" must terminate with an empty line to
' detect end of file (else error).

DEFINT I-N

'YesNo$, choice$: Chars
'isize, iwhere, ihmn: Integers

DIM a$(100)

    CLS
    GOSUB 500  'read names from input file

10  INPUT " What name would you like to look for? "; target$
    INPUT " Linear serach for (f)irst, (a)ll, or (b)inary? "; choice$
	
    IF choice$ = "a" THEN
      GOSUB 1000   'call FindAll(isize, ihmn)
      IF ihmn > 0 THEN
	PRINT " "; ihmn; " occurence(s) found."
      ELSE
	PRINT " "; target$; " not found."
      END IF
    ELSEIF choice$ = "b" THEN
      lo = 1: ih = isize
      GOSUB 2000  'call Binary(1,isize,iwhere)
      IF iwhere > 0 THEN
	PRINT " "; target$; " found at position "; iwhere; "."
      ELSE
	PRINT " "; target$; " not found."
      END IF
    ELSEIF choice$ = "f" THEN
      GOSUB 3000  'call FindFirst(isize,iwhere)
      IF iwhere > 0 THEN
	PRINT " "; target$; " found at position "; iwhere; "."
      ELSE
	PRINT " "; target$; " not found."
      END IF
    END IF

    INPUT " Try again (y/n)? "; YesNo$
    IF YesNo$ = "y" THEN GOTO 10

END

500 'read list of names
    OPEN "search.dat" FOR INPUT AS #1
    isize = 1
510 INPUT #1, a$(isize)
    isize = isize + 1
    IF a$(isize - 1) <> "" THEN GOTO 510
    isize = isize - 2
    CLOSE #1
    PRINT
    PRINT " # of items in list = "; isize
RETURN

'searching subroutines

1000 'FindAll(isize, ihmn)
' Linear search of a list of names for all occurences
' of target value.
  ihmn = 0
  FOR i = 1 TO isize
    IF a$(i) = target$ THEN
      PRINT " "; target$; " at position "; i; "."
      ihmn = ihmn + 1
    END IF
  NEXT i
RETURN

2000 'Binary(lo,ih, iwhere)
' Binary search of an ordered list for one occurence of
' specified target value. Assumes lo (low) < ih (high),
' i.e. there is something in the list to look for.
     iwhere = 0
2010 IF lo <= ih AND iwhere = 0 THEN
       mid = (lo + ih) / 2
       IF a$(mid) = target$ THEN
	 iwhere = mid
       ELSEIF a$(mid) > target$ THEN
	 ih = mid - 1
       ELSE
	 lo = mid + 1
       END IF
       GOTO 2010
     END IF
RETURN

3000 'FindFirst(isize, iwhere)
' Linear search of a list of names for first occurence
' of target value.
     iwhere = 1
3010 IF a$(iwhere) <> target$ AND iwhere < isize THEN
       iwhere = iwhere + 1
       GOTO 3010
     END IF
     IF a$(iwhere) <> target$ THEN iwhere = 0
RETURN

'end of file search.bas