! sqrsh (sqr shell)
! Copyright (C) 1997 Ray Ontko & Company
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2 of the License, or
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!++
!
! bsearch
!
! bsearch file_name proc_name array_name field_name field_type array_count
!
! bsearch myprog.sqh search_proc my_array my_field NUMBER #my_array_count
!
! writes to file_name a binary search routine
! on the array $array_name, field $field_name
! on rows in the array 0 through the value contained
! in $count_name.  $field_type is used to determine
! the type of parameters to pass.
!
! The generated routine is of the form
! begin-procedure procedure_name( $key , :#index ) or
! begin-procedure procedure_name( #key , :#index )
! and returns in #index the position of the key
! in the array or -1 if not found.
!
!--
!
! Author
!
! Ray Ontko
! Ray Ontko & Company
! Richmond, In 47375
!
!
! Modification History
!
! Name             Date       Comment
! ---------------- ---------- ----------------------------------------
! Ray Ontko        1997/06/01 Added this header
!


!
! To do
!
! restructure to use fixup_files 
!

!---------------------------------------------------------------- bsearch
begin-procedure bsearch local
if isnull( $_p1 )
   input $file_name 'File name'
else
   move $_p1 to $file_name
end-if
if isnull( $_p2 )
   input $procedure_name 'Procedure name'
else
   move $_p2 to $procedure_name
end-if
if isnull( $_p3 )
   input $array_name 'Array name'
else
   move $_p3 to $array_name
end-if
if isnull( $_p4 )
   input $field_name 'Field name'
else
   move $_p4 to $field_name
end-if
if isnull( $_p5 )
   input $field_type 'Field type (NUMBER or CHAR)'
else
   move $_p5 to $field_type
end-if
if isnull( $_p6 )
   input $count_name 'Name of global variable containing # of elements in array'
else
   move $_p6 to $count_name
end-if

uppercase $field_type
if $field_type = 'NUMBER'
  move '#key' to $key
  move '#element' to $element
else
  move '$key' to $key
  move '$element' to $element
end-if

if substr( $count_name , 1 , 1 ) = '#'
   let $count_name = '#_' ||
       substr( $count_name , 2 , length( $count_name ) - 1 )
end-if

open $file_name as 1 for-writing record={SQRSH_LINE_MAX}:vary status=#status
!
! note: if the array is less than a certain size, it will be
! faster to simply do a linear search.  In this case, we
! might generate a routine that picks the fastest algorithm.
! Note that fastest will be different depending on whether
! the item will always be found, or sometimes not be found.
! In this case, we might keep bsearch and add lsearch.
!
write 1 from '!! this file generated by sqrsh (bsearch)'
write 1 from 'begin-procedure ' $procedure_name ' ( ' $key ' , :#index )'
write 1 from '   move -1 to #index'
write 1 from '   move 0 to #lo'
write 1 from '   move ' $count_name ' to #hi'
write 1 from '   subtract 1 from #hi'
write 1 from '   while #lo <= #hi'
write 1 from '      let #i = floor( ( #hi + #lo ) / 2 )'
write 1 from '      get ' $element ' from ' $array_name '(#i) ' $field_name
write 1 from '      if ' $key ' = ' $element
write 1 from '         move #i to #index'
write 1 from '         break'
write 1 from '      end-if'
write 1 from '      if ' $key ' < ' $element
write 1 from '         move #i to #hi'
write 1 from '         subtract 1 from #hi'
write 1 from '      else'
write 1 from '         move #i to #lo'
write 1 from '         add 1 to #lo'
write 1 from '      end-if'
write 1 from '   end-while'
write 1 from 'end-procedure ' $procedure_name
close 1
end-procedure ! bsearch