Jason Aller Floppy Collection/101.img/QB45-1.ZIP/INDEX.BAS

BASIC Source File | 1987-09-23 | 9.7 KB | 311 lines

DEFINT A-Z

' Define the symbolic constants used globally in the program:
CONST FALSE = 0, TRUE = NOT FALSE

' Define a record structure for random-file records:
TYPE StockItem
   PartNumber  AS STRING * 6
   Description AS STRING * 20
   UnitPrice   AS SINGLE
   Quantity    AS INTEGER
END TYPE

' Define a record structure for each element of the index:
TYPE IndexType
   RecordNumber AS INTEGER
   PartNumber   AS STRING * 6
END TYPE

' Declare procedures that will be called:
DECLARE FUNCTION Filter$ (Prompt$)
DECLARE FUNCTION FindRecord% (PartNumber$, RecordVar AS StockItem)

DECLARE SUB AddRecord (RecordVar AS StockItem)
DECLARE SUB InputRecord (RecordVar AS StockItem)
DECLARE SUB PrintRecord (RecordVar AS StockItem)
DECLARE SUB SortIndex ()
DECLARE SUB ShowPartNumbers ()

' Define a buffer (using the StockItem type) and
' define & dimension the index array:
DIM StockRecord AS StockItem, Index(1 TO 100) AS IndexType

' Open the random-access file:
OPEN "STOCK.DAT" FOR RANDOM AS #1 LEN = LEN(StockRecord)

' Calculate number of records in the file:
NumberOfRecords = LOF(1) \ LEN(StockRecord)

' If there are records, read them and build the index:
IF NumberOfRecords <> 0 THEN
   FOR RecordNumber = 1 TO NumberOfRecords

      ' Read the data from a new record in the file:
      GET #1, RecordNumber, StockRecord

      ' Place part number and record number in index:
      Index(RecordNumber).RecordNumber = RecordNumber
      Index(RecordNumber).PartNumber = StockRecord.PartNumber
   NEXT

   SortIndex            ' Sort index in part-number order.
END IF

DO                      ' Main-menu loop.
   CLS
   PRINT "(A)dd records."
   PRINT "(L)ook up records."
   PRINT "(Q)uit program."
   PRINT
   LOCATE , , 1
   PRINT "Type your choice (A, L, or Q) here: ";

   ' Loop until user presses, A, L, or Q:
   DO
      Choice$ = UCASE$(INPUT$(1))
   LOOP WHILE INSTR("ALQ", Choice$) = 0

   ' Branch according to choice:
   SELECT CASE Choice$
      CASE "A"
         AddRecord StockRecord
      CASE "L"
         IF NumberOfRecords = 0 THEN
            PRINT : PRINT "No records in file yet. ";
            PRINT "Press any key to continue.";
            Pause$ = INPUT$(1)
         ELSE
            InputRecord StockRecord
         END IF
      CASE "Q"          ' End program
   END SELECT
LOOP UNTIL Choice$ = "Q"

CLOSE #1                ' All done, close file and end.
END
'
' ======================== ADDRECORD =========================
'  Adds records to the file from input typed at the keyboard.
' ============================================================
'
SUB AddRecord (RecordVar AS StockItem) STATIC
   SHARED Index() AS IndexType, NumberOfRecords
   DO
      CLS
      INPUT "Part Number: ", RecordVar.PartNumber
      INPUT "Description: ", RecordVar.Description
      RecordVar.UnitPrice = VAL(Filter$("Unit Price : "))
      RecordVar.Quantity = VAL(Filter$("Quantity   : "))

      NumberOfRecords = NumberOfRecords + 1

      PUT #1, NumberOfRecords, RecordVar

      Index(NumberOfRecords).RecordNumber = NumberOfRecords
      Index(NumberOfRecords).PartNumber = RecordVar.PartNumber
      PRINT : PRINT "Add another? ";
      OK$ = UCASE$(INPUT$(1))
   LOOP WHILE OK$ = "Y"

   SortIndex            ' Re-sort index file.
END SUB
'
' ========================= FILTER ===========================
'       Filters all non-numeric characters from a string
'       and returns the filtered string.
' ============================================================
'
FUNCTION Filter$ (Prompt$) STATIC
   ValTemp2$ = ""
   PRINT Prompt$;                    ' Print the prompt passed.
   INPUT "", ValTemp1$               ' Input a number as
                                     ' a string.
   StringLength = LEN(ValTemp1$)     ' Get the string's length.
   FOR I% = 1 TO StringLength        ' Go through the string,
      Char$ = MID$(ValTemp1$, I%, 1) ' one character at a time.

      ' Is the character a valid part of a number (i.e.,
      ' a digit or a decimal point)?  If yes, add it to
      ' the end of a new string:
      IF INSTR(".0123456789", Char$) > 0 THEN
         ValTemp2$ = ValTemp2$ + Char$

      ' Otherwise, check to see if it's a lowercase "l",
      ' since users used to typewriters may enter a one
      ' value that way:
      ELSEIF Char$ = "l" THEN
         ValTemp2$ = ValTemp2$ + "1" ' Change the "l" to a "1".
      END IF
   NEXT I%

   Filter$ = ValTemp2$           ' Return filtered string.

END FUNCTION
'
' ======================= FINDRECORD =========================
'     Uses a binary search to locate a record in the index.
' ============================================================
'
FUNCTION FindRecord% (Part$, RecordVar AS StockItem) STATIC
   SHARED Index() AS IndexType, NumberOfRecords

   ' Set top and bottom bounds of search:
   TopRecord = NumberOfRecords
   BottomRecord = 1

   ' Search until top of range is less than bottom:
   DO UNTIL (TopRecord < BottomRecord)

      ' Choose midpoint:
      Midpoint = (TopRecord + BottomRecord) \ 2

      ' Test to see if it's the one wanted (RTRIM$() trims
      ' trailing blanks from a fixed string):
      Test$ = RTRIM$(Index(Midpoint).PartNumber)

      ' If it is, exit loop:
      IF Test$ = Part$ THEN
         EXIT DO

      ' Otherwise, if what we're looking for is greater,
      ' move bottom up:
      ELSEIF Part$ > Test$ THEN
         BottomRecord = Midpoint + 1

      ' Otherwise, move the top down:
      ELSE
         TopRecord = Midpoint - 1
      END IF
   LOOP

   ' If part was found, get record from file using
   ' pointer in index and set FindRecord% to TRUE:
   IF Test$ = Part$ THEN
      GET #1, Index(Midpoint).RecordNumber, RecordVar
      FindRecord% = TRUE

   ' Otherwise, if part was not found, set FindRecord%
   ' to FALSE:
   ELSE
      FindRecord% = FALSE
   END IF
END FUNCTION
'
' ======================= INPUTRECORD ========================
'    First, INPUTRECORD calls SHOWPARTNUMBERS, which
'    prints a menu of part numbers on the top of the screen.
'    Next, INPUTRECORD prompts the user to enter a part
'    number. Finally, it calls the FINDRECORD and PRINTRECORD
'    procedures to find and print the given record.
' ============================================================
'
SUB InputRecord (RecordVar AS StockItem) STATIC
   CLS
   ShowPartNumbers      ' Call the ShowPartNumbers SUB.

   ' Print data from specified records on the bottom
   ' part of the screen:
   DO
      PRINT "Type a part number listed above ";
      INPUT "(or Q to quit) and press <ENTER>: ", Part$
      IF UCASE$(Part$) <> "Q" THEN
         IF FindRecord(Part$, RecordVar) THEN
            PrintRecord RecordVar
         ELSE
            PRINT "Part not found."
         END IF
      END IF
      PRINT STRING$(40, "_")
   LOOP WHILE UCASE$(Part$) <> "Q"

   VIEW PRINT   ' Restore the text viewport to entire screen.
END SUB
'
' ======================= PRINTRECORD ========================
'                Prints a record on the screen
' ============================================================
'
SUB PrintRecord (RecordVar AS StockItem) STATIC
   PRINT "Part Number: "; RecordVar.PartNumber
   PRINT "Description: "; RecordVar.Description
   PRINT USING "Unit Price :$$###.##"; RecordVar.UnitPrice
   PRINT "Quantity   :"; RecordVar.Quantity
END SUB
'
' ===================== SHOWPARTNUMBERS ======================
'  Prints an index of all the part numbers in the upper part
'  of the screen.
' ============================================================
'
SUB ShowPartNumbers STATIC
   SHARED Index() AS IndexType, NumberOfRecords

   CONST NUMCOLS = 8, COLWIDTH = 80 \ NUMCOLS

   ' At the top of the screen, print a menu indexing all
   ' the part numbers for records in the file.  This menu is
   ' printed in columns of equal length (except possibly the
   ' last column, which may be shorter than the others):
   ColumnLength = NumberOfRecords
   DO WHILE ColumnLength MOD NUMCOLS
      ColumnLength = ColumnLength + 1
   LOOP
   ColumnLength = ColumnLength \ NUMCOLS
   Column = 1
   RecordNumber = 1
   DO UNTIL RecordNumber > NumberOfRecords
      FOR Row = 1 TO ColumnLength
         LOCATE Row, Column
         PRINT Index(RecordNumber).PartNumber
         RecordNumber = RecordNumber + 1
         IF RecordNumber > NumberOfRecords THEN EXIT FOR
      NEXT Row
      Column = Column + COLWIDTH
   LOOP

   LOCATE ColumnLength + 1, 1
   PRINT STRING$(80, "_")       ' Print separator line.

   ' Scroll information about records below the part-number
   ' menu (this way, the part numbers are not erased):
   VIEW PRINT ColumnLength + 2 TO 24
END SUB
'
' ========================= SORTINDEX ========================
'                Sorts the index by part number
' ============================================================
'
SUB SortIndex STATIC
   SHARED Index() AS IndexType, NumberOfRecords

   ' Set comparison offset to half the number of records
   ' in index:
   Offset = NumberOfRecords \ 2

   ' Loop until offset gets to zero:
   DO WHILE Offset > 0
      Limit = NumberOfRecords - Offset
      DO

         ' Assume no switches at this offset:
         Switch = FALSE

         ' Compare elements and switch ones out of order:
         FOR I = 1 TO Limit
            IF Index(I).PartNumber > Index(I + Offset).PartNumber THEN
               SWAP Index(I), Index(I + Offset)
               Switch = I
            END IF
         NEXT I

         ' Sort on next pass only to where last
         ' switch was made:
         Limit = Switch
      LOOP WHILE Switch

      ' No switches at last offset, try one half as big:
      Offset = Offset \ 2
   LOOP
END SUB