'===========================================================================
' Subject: EDITING RANDON ACCESS FILE        Date: 11-24-95 (00:00)       
' Author:  Kenneth W. Melvin                 Code: QB, QBasic, PDS        
' Origin:  kwmelvin@nr.infi.net            Packet: TEXT.ABC
'===========================================================================
'+------------------------------------------------------------------+
'| Filename: KEN-ED03.BAS                                           |
'|     Date: 11-24-95                                               |
'|  Purpose: Simple example of editing a random access file using   |
'|         : structured Qbasic. This is part of an ongoing series   |
'|         : of personal programming examples for learning QBasic   |
'|  Version: 0.03   ( added Ethan Winer's Editor subprocedure )     |
'|   Author: kwmelvin@nr.infi.net <Kenneth W. Melvin>               |
'|    Kudos: Thanks to Phil Wright for his patient tutorials, and to|
'|         : Dave Gjessing for encouragement and support, and to    |
'|         : Ethan Winer for _BASIC Techniques and Utilities_       |
'| Language: QBasic 1.1      drive:\> QBASIC /RUN KEN-ED03          |
'|    Notes: Documentation (started 11-21-95)                       |
'|         : Add graphics routines from DEMOSCRN.BAS                |
'|         : Add sorting routine                                    |
'|    * New: Now choose a record to Edit from the display list      |
'|         : Note the use of the FRE() function to measure memory   |
'|         : If user presses 0 or >NumRec, she's taken back to Menu |
'|         : Editor subprocedure added to EnterRecord and EditRecord|
'+------------------------------------------------------------------+
'===================================================================+
'---- PSEUDOCODE version 0.03                                       |
'1. Open the random access file                                     |
'2. Display beginning file statistics                               |
'3. LOOP until menu option "Q" is chosen                            |
'   3.1 Display the menu and input choice                           |
'   3.2 Execute the correct subprocedure                            |
'       3.2.1  Enter a record                                       |
'       3.2.2  List a record                                        |
'       3.2.3  Edit a record                                        |
'       3.2.4  Quit                                                 |
'4. Display ending file statistics                                  |
'5. Close the random access file                                    |
'6. Stop                                                            |
'                                                                   |
'---- Enter a Record                                                |
'1. Input the data for the new record using Editor                  |
'2. Ask if there's another new record to Enter                      |
'3. IF the answer is Yes THEN LOOP                                  |
'   ELSE                                                            |
'4. End Sub                                                         |
'                                                                   |
'---- List a Record                                                 |
'1. Define the keystrokes and capture them                          |
'2. Display the records to the screen and wait for user input       |
'   2.1 If Right Arrow is pressed, increment record shown           |
'   2.2 If Left Arrow is pressed, decrement record shown            |
'   2.3 If Enter is pressed, Edit the record shown                  |
'       2.3.1 Enter editing sub and print chosen record to screen   |
'       2.3.2 Ask which line to edit (menu right now)               |
'       2.3.3 Use Editor sub to edit each line.                     |
'       2.3.4 Edit another line?                                    |
'       2.3.5 If Yes, loop to 2.3.3                                 |
'       2.3.6 If No, Edit another record?                           |
'       2.3.7 If Yes, get record number to edit and loop to 2.3.1   |
'       2.3.8 If No, go back to main menu.                          |
'   2.4 If Esc is pressed, return to the main menu.                 |
'                                                                   |
'---- Edit a Record                                                 |
'1. Ask for record number to edit                                   |
'   1.1 If record number entered is 0, ask again                    |
'   1.2 If record number does not exist                             |
'       1.2.1 Show a brief error message                            |
'       1.2.2 Return to main menu                                   |
'2. Edit the record chosen                                          |
'   2.1 Enter the editing sub and print the chosen record to screen |
'   2.2 Ask user to choose which line to edit (menu right now)      |
'   2.3 Use Editor sub to edit each line.                           |
'   2.4 Edit another line?                                          |
'   2.5 If Yes, loop to 2.3                                         |
'   2.6 If No, Edit another record?                                 |
'   2.7 If Yes, get record number to edit and loop to 2.1           |
'   2.8 If No, go back to main menu.                                |
'                                                                   |
'---- File Statistics                                               |
'1. Display data file statistics for learning purposes only         |
'   These routines may be removed when no longer needed             |
'   1.1 Show data file length at start and end of program           |
'   1.2 Show record size                                            |
'   1.3 Show number of records in file                              |
'   1.4 Show total heap space available                             |
'   1.5 Show total string space available                           |
'2. The MemAvail sub is called from several locations               |
'                                                                   |
'---- End of Program                                                |
'1. Display final file statistics                                   |
'2. Close all open files.                                           |
'===================================================================+

' *** Declarations ***
DECLARE SUB EnterScreen (NumRec%)
DECLARE SUB Kprint (Text$, Row%, Col%, Fg%, Bg%)
DECLARE SUB EditARecord (RecordToEdit%)
DECLARE SUB Editor (Text$, LeftCol%, RightCol%, KeyCode%)
DECLARE SUB EnterRecord (NumRec%)
DECLARE SUB DataFileStats (FileLen%, RecSize%, NumRec%)
DECLARE SUB DisplayRecord (NumRec%)
DECLARE SUB MemAvail (Row%, Col%)
DECLARE SUB PrintTheMenu ()

REM $DYNAMIC 'for use by MemAvail

DEFINT A-Z
' *** TYPE Structure ***
TYPE MyFriends
    LastName AS STRING * 14
    FirstName AS STRING * 14
    StreetAdd AS STRING * 28
    City AS STRING * 14
    State AS STRING * 2
    ZipCode AS STRING * 10
    Phone AS STRING * 14
    Birthday AS STRING * 10
    Comments AS STRING * 50
END TYPE

' *** Dimension variable of TYPE MyFriends ***
DIM Friend AS MyFriends

' *** Open a random access file ***
OPEN "KEN-ED03.DAT" FOR RANDOM AS #1 LEN = LEN(Friend)

' *** Define some variables ***
FileLen = LOF(1)
RecSize = LEN(Friend)
NumRec = LOF(1) / LEN(Friend)

' *** Show Datafile statistics ***
CALL DataFileStats(FileLen, RecSize, NumRec)
CALL Kprint("Press any key to continue", 25, 1, 7, 0)
SLEEP

' *** MAIN PROGRAM LINE ***
BeginHere:
DO
  CALL PrintTheMenu
  Sel$ = INPUT$(1)
  SELECT CASE Sel$
    CASE "E", "e"
        CALL EnterRecord(NumRec)
    CASE "L", "l"
        CALL DisplayRecord(NumRec)
    CASE "D", "d"
        CALL EditARecord(RecordToEdit)
    CASE "Q", "q"
        GOTO EndProgram
    CASE ELSE
        GOTO BeginHere
  END SELECT
LOOP UNTIL UCASE$(Sel$) = "Q"

EndProgram:
CLS
FileLen = LOF(1)
RecSize = LEN(Friend)
NumRec = LOF(1) / LEN(Friend)
CALL DataFileStats(FileLen, RecSize, NumRec)
CLOSE
END

'*** END OF PROGRAM ***

REM $STATIC
SUB DataFileStats (FileLen, RecSize, NumRec)
    CLS
    CALL Kprint("DATABASE FILE STATISTICS", 10, 27, 3, 0): COLOR 7, 0
    LOCATE 12, 30: PRINT "FileSize:"; FileLen; "bytes"
    LOCATE 13, 28: PRINT "RecordSize:"; RecSize; "bytes"
    LOCATE 14, 27: PRINT "No. Records:"; NumRec
    CALL MemAvail(15, 21)
END SUB

SUB DisplayRecord (NumRec)
CLS
DIM Friend AS MyFriends  'this DIM statement has to be here, or QBasic
                            'shows an error message:"Identifier cannot
                            'include period."  Highlight on Friend.LastName.
X = 1                   'initialize record number
DO                      'begin display loop
    Ky$ = INKEY$        'capture a keypress
    IF Ky$ <> "" THEN
        IF Ky$ = CHR$(0) + "M" THEN X = X + 1   '-> arrow key - next
        IF Ky$ = CHR$(0) + "K" THEN X = X - 1   '<- arrow key - previous
        IF Ky$ = CHR$(13) THEN CALL EditARecord(X): EXIT SUB '<Enter> - edit
        IF Ky$ = CHR$(27) THEN EXIT SUB         ' <Esc> key - exit
    END IF
   
    IF X = 0 THEN X = NumRec                    ' wrap-around when record
    IF X > NumRec THEN X = 1                    ' goes past end or beginning
    IF X < 1 THEN X = 1

    GET #1, X, Friend       'get #filenum, recordnumber, variable
    LOCATE 5, 30: COLOR 3, 0: PRINT "Record No."; X: COLOR 7, 0
    LOCATE 7, 25: PRINT Friend.LastName, Friend.FirstName
    LOCATE 8, 25: PRINT Friend.StreetAdd
    LOCATE 9, 25: PRINT Friend.City; Friend.State; " "; Friend.ZipCode
    LOCATE 10, 25: PRINT Friend.Phone,
    LOCATE 11, 25: PRINT Friend.Birthday
    LOCATE 12, 25: PRINT Friend.Comments
    
    'Screen Legend
    LOCATE 14, 25: COLOR 4, 0: PRINT "< ";CHR$(26);" >"; : COLOR 7, 0: PRINT " = Next Record"
    LOCATE 15, 25: COLOR 4, 0: PRINT "<  >"; : COLOR 7, 0: PRINT " = Previous Record"
    LOCATE 16, 25: COLOR 4, 0: PRINT "<ΔΩ>"; : COLOR 7, 0: PRINT " = Edit Record"
    LOCATE 17, 25: COLOR 4, 0: PRINT "<Esc>"; : COLOR 7, 0: PRINT " = Exit";
    CALL MemAvail(20, 25)
    SLEEP: CLS
LOOP
END SUB

SUB EditARecord (RecordToEdit)
    DIM Friend AS MyFriends

'****** Main editing loop ***
DO
    CLS
    NumRec = LOF(1) / LEN(Friend)
    IF RecordToEdit >= 1 THEN GOSUB PrintExistingRecord
    IF RecordToEdit = 0 THEN
        LOCATE 12, 20: COLOR 7, 0
        INPUT "Edit which record number?: ", RecordToEdit
    ELSEIF RecordToEdit > NumRec THEN
TryAgain:
        CALL Kprint("ERROR - That record doesn't exist!", 12, 25, 3, 0)
        RecordToEdit = 0
        SLEEP 5
    END IF
    GOSUB PrintExistingRecord
   
StartLineEdit:
    LOCATE 15, 1: PRINT "[press zero (0) to exit]": CALL MemAvail(20, 25)
    LOCATE 16, 1: INPUT "Choose a line to edit (1-9): ", Choice
        IF Choice = 0 THEN EXIT SUB
    SELECT CASE Choice
       
        CASE 1
            LOCATE 3, 26: COLOR 14, 0
            CALL Editor(Friend.LastName, 26, 40, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 2
            LOCATE 4, 26: COLOR 14, 0
            CALL Editor(Friend.FirstName, 26, 40, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 3
            LOCATE 5, 26: COLOR 14, 0
            CALL Editor(Friend.StreetAdd, 26, 54, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 4
            LOCATE 6, 26: COLOR 14, 0
            CALL Editor(Friend.City, 26, 40, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 5
            LOCATE 7, 26: COLOR 14, 0
            CALL Editor(Friend.State, 26, 28, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 6
            LOCATE 8, 26: COLOR 14, 0
            CALL Editor(Friend.ZipCode, 26, 36, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 7
            LOCATE 9, 26: COLOR 14, 0
            CALL Editor(Friend.Phone, 26, 40, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 8
            LOCATE 10, 26: COLOR 14, 0
            CALL Editor(Friend.Birthday, 26, 36, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE 9
            LOCATE 11, 26: COLOR 14, 0
            CALL Editor(Friend.Comments, 26, 76, KeyCode)
            PUT #1, RecordToEdit, Friend: GOSUB PrintExistingRecord
       
        CASE ELSE
            BEEP: GOTO StartLineEdit
    END SELECT
    
    'clear lines from screen
    LOCATE 16, 1: PRINT STRING$(70, CHR$(32))
    LOCATE 17, 1: PRINT STRING$(70, CHR$(32))
   
    LOCATE 16, 1: PRINT "Edit another line? Y/N"; : Ans$ = INPUT$(1)
    IF UCASE$(Ans$) = "Y" THEN GOTO StartLineEdit
   
    CALL Kprint("Edit another record? Y/N", 18, 1, 4, 0)       'ask user for
    Ans$ = INPUT$(1): COLOR 7, 0: RecordToEdit = 0             'input...
    IF UCASE$(Ans$) = "N" THEN EXIT SUB      'get out of here if answer is No
LOOP WHILE UCASE$(Ans$) = "Y"                'loop as long as they answer Yes


'---- this routine is used to show the edits made and is also a menu
'     for selection of which line to edit.
PrintExistingRecord:
    
    CLS
    NumRec = LOF(1) / LEN(Friend)
    IF RecordToEdit > NumRec THEN GOTO TryAgain
    IF RecordToEdit = 0 THEN EXIT SUB
    GET #1, RecordToEdit, Friend
    LOCATE 2, 1: COLOR 3, 0: PRINT "Edit Record #"; RecordToEdit: COLOR 7, 0
    PRINT "1) Last Name           : "; Friend.LastName
    PRINT "2) First Name          : "; Friend.FirstName
    PRINT "3) Street Address      : "; Friend.StreetAdd
    PRINT "4) City                : "; Friend.City
    PRINT "5) State               : "; Friend.State
    PRINT "6) Zip Code            : "; Friend.ZipCode
    PRINT "7) Phone               : "; Friend.Phone
    PRINT "8) Birthday            : "; Friend.Birthday
    PRINT "9) Comments            : "; Friend.Comments
    COLOR 7, 0
RETURN

END SUB

SUB Editor (Text$, LeftCol, RightCol, KeyCode) STATIC
  '---- Editor is a single line text editor
  '---- Find the cursor's size
  DEF SEG = 0
  IF PEEK(&H463) = &HB4 THEN
        CsrSize = 12                'mono uses 13 scan lines
  ELSE
        CsrSize = 7                 'color uses 8
  END IF

  '----Work with a temporary copy
  Edit$ = SPACE$(RightCol - LeftCol + 1)
  LSET Edit$ = Text$

  '---- See where to begin editing and print the string.
  TxtPos = POS(0) - LeftCol + 1
  IF TxtPos < 1 THEN TxtPos = 1
  IF TxtPos > LEN(Edit$) THEN TxtPos = LEN(Edit$)

  LOCATE , LeftCol
  PRINT Edit$;

  '---- This is the main loop for handling key presses
  DO
        LOCATE , LeftCol + TxtPos - 1, 1

        DO
          Ky$ = INKEY$
        LOOP UNTIL LEN(Ky$)             'wait for a keypress

        IF LEN(Ky$) = 1 THEN            'create a key code
          KeyCode = ASC(Ky$)            'regular character key
        ELSE                            'extended key
          KeyCode = -ASC(RIGHT$(Ky$, 1))
        END IF

        '---- Branch according to the key pressed
        SELECT CASE KeyCode

          '---- Backspace: decrement the pointer and the
          '     cursor, and ignore if in the first column.
          CASE 8
                TxtPos = TxtPos - 1
                LOCATE , LeftCol + TxtPos - 1, 0
                IF TxtPos > 0 THEN
                  IF InsStatus THEN
                        MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "
                  ELSE
                        MID$(Edit$, TxtPos) = " "
                  END IF
                        PRINT MID$(Edit$, TxtPos);
                END IF

          '---- Enter or Escape: this block is optional in
          '     case you want to handle these separately.
          CASE 13, 27
                EXIT DO                 'exit the subprogram

          '---- Letter keys: turn off the cursor to hide
          '     the printing, handle Insert mode as needed.
          CASE 32 TO 254
                LOCATE , , 0
                IF InsStatus THEN       'expand the string
                  MID$(Edit$, TxtPos) = Ky$ + MID$(Edit$, TxtPos)
                  PRINT MID$(Edit$, TxtPos);
                ELSE                    'else insert character
                  MID$(Edit$, TxtPos) = Ky$
                  PRINT Ky$;
                END IF
                TxtPos = TxtPos + 1     'update position counter

          '---- Left arrow: decrement the position counter.
          CASE -75
                TxtPos = TxtPos - 1

          '---- Right arrow: increment position counter.
          CASE -77
                TxtPos = TxtPos + 1

          '---- Home: jump to the first character position.
          CASE -71
                TxtPos = 1

          '---- End: search for the last non-blank, and
          '     make that the current editing position.
          CASE -79
                FOR N = LEN(Edit$) TO 1 STEP -1
                  IF MID$(Edit$, N, 1) <> " " THEN EXIT FOR
                NEXT
                TxtPos = N + 1
                IF TxtPos > LEN(Edit$) THEN TxtPos = LEN(Edit$)

          '---- Insert key: toggle the Insert state and
          '     adjust the cursor size.
          CASE -82
                InsStatus = NOT InsStatus
                IF InsStatus THEN
                  LOCATE , , , 0, CsrSize
                ELSE
                  LOCATE , , , CsrSize - 1, CsrSize
                END IF
          
          '---- Delete: delete the current character and
          '     reprint what remains in the string.
          CASE -83
                MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "
                LOCATE , , 0
                PRINT MID$(Edit$, TxtPos);

          '---- All other keys: exit the subprogram
          CASE ELSE
                EXIT DO
        END SELECT
  '---- Loop until the cursor moves out of the field.
  LOOP UNTIL TxtPos < 1 OR TxtPos > LEN(Edit$)

  Text$ = RTRIM$(Edit$)         'trim the text

END SUB

SUB EnterRecord (NumRec)
CLS
DIM Friend AS MyFriends     'this DIM statement has to be here, or QBasic
                            'shows an error message:Identifier cannot include
                            'period.    Highlight on Friend.LastName.
DO
    GOSUB InitializeScreen
    CALL MemAvail(20, 25)
            LOCATE 3, 1: COLOR 14, 0
            CALL Editor(Friend.LastName, 26, 40, KeyCode): COLOR 7, 0
          
            LOCATE 4, 1: COLOR 14, 0
            CALL Editor(Friend.FirstName, 26, 40, KeyCode): COLOR 7, 0
          
            LOCATE 5, 1: COLOR 14, 0
            CALL Editor(Friend.StreetAdd, 26, 54, KeyCode): COLOR 7, 0
          
            LOCATE 6, 1: COLOR 14, 0
            CALL Editor(Friend.City, 26, 40, KeyCode): COLOR 7, 0
          
            LOCATE 7, 1: COLOR 14, 0
            CALL Editor(Friend.State, 26, 28, KeyCode): COLOR 7, 0
          
            LOCATE 8, 1: COLOR 14, 0
            CALL Editor(Friend.ZipCode, 26, 36, KeyCode): COLOR 7, 0
          
            LOCATE 9, 1: COLOR 14, 0
            CALL Editor(Friend.Phone, 26, 40, KeyCode): COLOR 7, 0
          
            LOCATE 10, 1: COLOR 14, 0
            CALL Editor(Friend.Birthday, 26, 36, KeyCode): COLOR 7, 0
          
            LOCATE 11, 1: COLOR 14, 0
            CALL Editor(Friend.Comments, 26, 76, KeyCode): COLOR 7, 0
            PUT #1, NumRec, Friend
           
    NumRec = LOF(1) / LEN(Friend)
    LOCATE 13, 1: PRINT "Enter another record? Y/N ";   'ask user for input
    Ans$ = INPUT$(1)
    GOSUB EnterANewRecord: CLS
LOOP WHILE UCASE$(Ans$) = "Y"               'loop as long as they answer Yes
GOTO ThisIsTheEnd

InitializeScreen:
    NumRec = NumRec + 1
    CALL EnterScreen(NumRec)
RETURN

EnterANewRecord:
    IF NumRec = 0 THEN EXIT SUB
    GET #1, NumRec, Friend
    Friend.LastName = ""
    Friend.FirstName = ""
    Friend.StreetAdd = ""
    Friend.City = ""
    Friend.State = ""
    Friend.ZipCode = ""
    Friend.Phone = ""
    Friend.Birthday = ""
    Friend.Comments = ""
RETURN

ThisIsTheEnd:
END SUB

SUB EnterScreen (NumRec)
    DIM Friend AS MyFriends
    LOCATE 2, 1: COLOR 3, 0: PRINT "Enter Record #"; NumRec: COLOR 7, 0
    PRINT "Last Name              : "
    PRINT "First Name             : "
    PRINT "Street Address         : "
    PRINT "City                   : "
    PRINT "State                  : "
    PRINT "Zip Code               : "
    PRINT "Phone                  : "
    PRINT "Birthday               : "
    PRINT "Comments               : "
    COLOR 7, 0
END SUB

SUB Kprint (Text$, Row, Col, Fg, Bg)
    LOCATE Row, Col
    COLOR Fg, Bg
    PRINT Text$;
END SUB

SUB MemAvail (Row, Col)
    LOCATE Row, Col
    PRINT "  Free heap space:"; FRE(-1)
    LOCATE (Row + 1), Col
    PRINT "Free string space:"; FRE(0)
    LOCATE , , 0
END SUB

SUB PrintTheMenu
  CLS
  CALL Kprint("Main Menu", 5, 31, 4, 0)
  CALL Kprint("E", 7, 31, 4, 0): CALL Kprint("nter a Record", 7, 32, 7, 0)
  CALL Kprint("L", 9, 31, 4, 0): CALL Kprint("ist Records", 9, 32, 7, 0)
  CALL Kprint("E", 11, 31, 7, 0): CALL Kprint("d", 11, 32, 4, 0)
  CALL Kprint("it Records", 11, 33, 7, 0)
  CALL Kprint("Q", 13, 31, 4, 0): CALL Kprint("uit", 13, 32, 7, 0)
  CALL Kprint("Choose", 15, 31, 4, 0): CALL Kprint(" E, L, D, ", 15, 37, 7, 0)
  CALL Kprint("or ", 15, 47, 4, 0): CALL Kprint("Q", 15, 50, 7, 0)
  CALL MemAvail(20, 25)
END SUB