************************************************************
*                     MAIN.PRG for phone system            *
************************************************************

set exact off
set deleted on
set fullread on
set exclusive off
set scoreboard on
set delimiters on

ESC  =27       && escape key

* -- create database and/or index if they don't exist
if file( "phone.dbf" ) = .f. 
	do createdbf
	do rebuild
else
	if file("phonenam.ndx") = .f. .or. file ("phonenam.k") = .f.
		do rebuild
	endif
endif

use phone index phonenam

mainchoice=1

* --- main processing loop
do while .t.

	clear
	set message to 24
	@  2,20 say "PHONE LIST MANAGER" font 'Helvetica Bold',18

* --- set frame menu items
	declare menu1[5]
	declare menu2[4]

        
	menu1[1]= .t.   && Horizontal=TRUE Vertical=FALSE
   
	menu1[2]=menu2
	
   menu1[3]="@I3  ~List Database"
	
   menu1[4]="@I4  ~Rebuild Database"
	
   menu1[5]="@I5  ~Quit"
	
	menu2[1]=     "~Maintain Database"
	menu2[2]="@I21 ~Add Phone Number"
	menu2[3]="@I22 ~Change Phone Number"
	menu2[4]="@I23 ~Delete Phone Number"
	
* -- invoke menu and wait for selection
	@ 2,4 menu from menu1 to mainchoice
	
* -- process item selected
	do case
		
		case mainchoice = 0 .or. mainchoice = 5   && QUIT
			exit
		
		case mainchoice=21        && ADD a new record
			do add
		
		case mainchoice=22        && CHANGE an existing record
			do modify with .f.
		
		case mainchoice=23        && DELETE an existing record
			do modify with .t.
		
		case mainchoice=3         && BROWSE records
			do view
		
		case mainchoice=4         && REINDEX database
			do rebuild
			use phone index phonenam
	endcase
enddo

clear
use
set scoreboard off
return

*********************    END OF MAIN.PRG      *********************

************************************************************
*                    REBUILD                               *
************************************************************
proc rebuild
clear
? 'rebuilding...  '

use phone

?? dbf(), 'contains', reccount(), 'records...'

SET BREAK OFF   && no ctrl breaks please

? 'packing...'
pack
?? '  done packing'

? 'indexing...'
index on upper(trim(lastname))+','+upper(trim(firstname)) to phonenam

?? '  done indexing...'

SET BREAK ON

msg( .f., 'done rebuilding.' )

use
inkey(1)

return
******************    END OF REBUILD.PRG        ******************


******************       ADD                  ******************

proc add

do while .t.
	 
* -- initialize and get data fields
	choice = 0
	m_first=spaces( len(firstname) )
	m_last =spaces( len(lastname)  )
	m_area =spaces( len(areacode)  )
	m_phone=spaces( len(phonenum)  )

	@  4,1    to 12,77 clear double  && draw a box
	@  5.0,3  say " Last name: " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
	@  6.8,3  say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
	@  8.6,3  say " Area code: " get m_area  picture '999'
	@  10.4,3 say "   Phone #: " get m_phone picture '999-9999'
	@  4.5,60                    get choice  picture "@*TV ~Add Record;~Quit" size 2.5,15

	read

	if readkey() = ESC .or. choice = 2     && quit without saving
		exit
	 endif
		
* -- edit check for required field
	if empty( m_last )
		msg( .t., "Last name required" )
		loop
	endif

	msg( .f., '' )

* -- add record and replace fields with data from screen
	append blank
	replace lastname with m_last
	replace firstname with m_first
	replace areacode with m_area
	replace phonenum with m_phone
		
	msg( .f., "Addition of " + trim(m_last) + ", " + trim(m_first) + " successful" )

enddo
return
****************    END OF ADD RECORDS MODULE        ****************


************************************************************
*                 CHANGE or DELETE RECORDS IN PHONE DATABASE
************************************************************
proc modify
para del

* -- set action dependent on parameter passed
act = iif( del, 'Delete', 'Change' )

do while .t.

* -- initialize and get data fields for finding record
    m_first=spaces(len(firstname))
    m_last=spaces(len(lastname))
    m_area=spaces(len(areacode))
    m_phone=spaces(len(phonenum))

    choice = 0

    @ 4,1 to 12,77 clear double && draw a box

    @ 5,3   say " Last name: " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
    @ 6.8,3 say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
    @ 4.5,60  get choice  picture "@*TV ~Find Record;~Quit" size 2.5,15
 
    @ 16,3 say "Whose number will you " + act + "?" font 'Helvetica',15

    @ 18,3 say 'Note - this search uses INDEX to find match'

    read

	 @ 13,3 clear
	 
    if (readkey() = ESC) .or. (choice = 2)  && quit without saving
        exit
    endif

* -- look for exact match for last name, comma, first name
    set exact on												
    seek upper( trim(m_last) + ',' + trim(m_first) )

    if found()
					&& found exact match - should check
		  			&& code here to see if a duplicate exists
    else 
			set exact off
			seek upper( trim( m_last ) )
			if .not. found()
                msgbox('Phone List', 'No exact match or partial match')
                loop
			else
* -- partial match found, so let user select record to change/delete
			   boxrec=boxbrowse(13,8,24,66)
               if lastkey() = 27 .or. boxrec = 0
			       loop
			   else
			       goto boxrec
               endif
           endif
	endif

* Okay, we found the name specified (or user picked one)

   msg( .f., '' )

*
* Alert user if they have picked a record from browse that doesn't 
*          match the original search criteria
*

   if (lastname  <> m_last  .and. len(trim(m_last))  > 0) .or.    ;
	   (firstname <> m_first .and. len(trim(m_first)) > 0) 
      tone( 1000,75 )
      @ 14,3 say 'Above was selected as a match for query on ' ; 
		             + trim(m_last)+ ',' + trim(m_first)
   endif

* -- set fields to data from record and prompt user to do a new
* -- search, change/delete, or quit without saving
   m_first=firstname
   m_last=lastname
   m_area=areacode
   m_phone=phonenum
   choice = 0
   @  5,3    say " Last name: " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
   @  6.8,3  say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
   @  8.6,3  say " Area code: " get m_area  picture '999'
   @  10.4,3 say "   Phone #: " get m_phone picture '999-9999'
   @  4.5,60                   get choice  picture "@*TV ~New Search;~"+act+";~Quit" size 2.5,15
   read

   if (readkey() = ESC) .or. (choice = 3)
      exit
   endif

    if choice = 1       && NEW SEARCH selected
        loop
    endif
        
    if del              && DELETE record
        delete
    else                && CHANGE record
        replace lastname with m_last
        replace firstname with m_first
        replace areacode with m_area
        replace phonenum with m_phone
    endif

    msg( .f., act+" of " + trim(m_last) + "," + trim(m_first) + " successful" )

enddo

return
************      END OF MODIFY RECORDS MODULE                ************


***********************************************************
*  view.prg        VIEW RECORDS IN PHONE DATABASE         *
***********************************************************
proc view

do while .t.

* -- initialize and get data fields for selecting records for browse
    m_first=spaces( len(firstname) )
    m_last =spaces( len(lastname)  )
    m_area =spaces( len(areacode)  )
    choice = 0

    @  4,1     to 12,77 clear double           && draw a box
    @  5,3     say " Last name = " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
    @  6.8,3   say "First name = " get m_first picture '!XXXXXXXXXXXXXX'
    @  8.6,3   say " Area code = " get m_area  picture '999'
    @  4.5,60                     get choice  picture "@*TV ~List;~Quit" size 2.5,15
    @  14,3    say "Enter Desired Criteria and select List to display"

    @  16,3 say 'Note - this list facility uses filters,'
    @  17,3 say '       therefore you may search multiple fields.'

    read 

    if (readkey() = ESC) .or. (choice = 2)  && QUIT
        exit
    endif

* -- set filter using fields indicated on screen
    flt = ''
	 pre = ''
	 if .not. empty( m_first )
	 	flt = "upper(firstname)=upper(m_first)"
	 	pre = " .AND. "
	 endif

	 if .not. empty( m_last )
	 	flt = flt + pre + "upper(lastname)=upper(m_last)"
	 	pre = " .AND. "
	 endif

	 if .not. empty( m_area )
	 	flt = flt + pre + "areacode=m_area"
	 endif

	 if len( flt ) > 0 
		 set filter to &flt
	 endif
	 
* -- BROWSE records with the filter set, if appropriate
	 goto top
	 boxrec=boxbrowse(13,1,24,69)
	 set filter to
	 
enddo

return
***************    END OF VIEW RECORDS MODULE            **************



****** CREATE THE DATABASE FROM SCRATCH ******
proc createdbf

* -- array containing fields in PHONE database
dbfflds = mkarray( mkarray( 'FIRSTNAME', 'C', 15 ), ;
                   mkarray( 'LASTNAME', 'C', 20 ), ;
                   mkarray( 'AREACODE',  'C', 3 ), ;
                   mkarray( 'PHONENUM',  'C', 8 ) )

	
	@ 14, 30 say "Creating database ..." + space (20)
    create phone from array dbfflds

* -- create list of indices file PHONE.DBX
    if .not. file( 'phone.dbx' )
        fp = fcreate( 'phone.dbx', 1 )
        if fp = -1
            msgbox( 'Phone Index List', 'Problem creating Phone Index List', 7 )
        else
            fseek( fp, 0, 2 )
            fwrite( fp, chr(13) + chr(10) + "phonenam=upper(trim(lastname))+', '+upper(trim(firstname))", 60 )
            fclose( fp )
        endif
    endif

    use phone

* -- create rec array to hold data for generated records
    declare rec[15]
    rec[ 1]=mkarray('Jean-Luc', 'Picard' ,   '417', '527-7269')
    rec[ 2]=mkarray('William',  'Riker'  ,   '417', '382-7304')
    rec[ 3]=mkarray('',         'Data'   ,   '203', '593-3836')
    rec[ 4]=mkarray('Beverly',  'Crusher',   '417', '284-8286')
    rec[ 5]=mkarray('Deanna',   'Troi',      '417', '729-3783')
    rec[ 6]=mkarray('',         'Worf'   ,   '203', '280-7289')
    rec[ 7]=mkarray('Geordi',   'LaForge',   '417', '774-2843')
    rec[ 8]=mkarray('Lwaxana',  'Troi',      '203', '824-2844')
    rec[ 9]=mkarray('Wesley',   'Crusher',   '809', '587-2798')
    rec[10]=mkarray('',         'Guinan',    '809', '483-2193')
    rec[11]=mkarray('Tasha',    'Yar',       '417', '387-8458')
    rec[12]=mkarray('Miles',    "O'Brien",   '203', '583-3987')
    rec[13]=mkarray('Ro',       'Laren',     '417', '964-2947')
    rec[14]=mkarray('',         'Q',         '666', '840-3928')
    rec[15]=mkarray('Gene',     'Rodenberry','809', '382-4287')

* -- loop to add records
    clear
    for i = 1 to len( rec )
        append blank
        @ 1,1 SAY 'Adding ' + STR(recno()) + ',' + rec[i][1] + ',' + rec[i][2] + ',' + rec[i][3] + ',' + rec[i][4] + spaces(10)
        replace lastname  with rec[i][2]
        replace areacode  with rec[i][3]
        replace phonenum  with rec[i][4]
        replace firstname with rec[i][1]
    next
    use
return


**** MESSAGE FUNC ****
func msg
para err, s

if len(s) <> 0
	if .not. err
		* success
		tone( 1000, 100 )
		tone( 1500, 100 )
		tone( 2000, 100 )
	else
		* error
		tone( 2000, 150 )
		tone( 1000, 150 )
	endif
endif

@ 13,6 clear
@ 13,6 say s	
return .t.

* --- end --- 
