home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR36
/
C7101.ZIP
/
REPEAT.CLA
< prev
next >
Wrap
Text File
|
1994-02-07
|
39KB
|
594 lines
PROGRAM
OMIT('┘')
┌────────────────────────────────────────────────────────────────────────────┐
│ │
│ REPEAT.CLA - The Repeat Support Module │
│ │
│ The Repeat Support Module manages the process of scrolling records │
│ through a POINT/REPEAT structure. Repeat support is conducted in a │
│ session that is initiated by the BeginRepeat procedure and │
│ terminated by the EndBrowse procedure. Multiple repeat sessions │
│ may be conducted at the same time (e.g. a repeat procedure calls a │
│ form which calls a lookup procedure). The current status of a │
│ repeat session is stored in a Session queue. The repeat process │
│ uses a position queue which contains a POSITION() string used to │
│ access displayed records. │
│ │
│ BeginRepeat(PointField,PointRows,LocatorField,ImmediateFlag, | │
│ IncrementFlag) │
│ │
│ Initiate a repeat session and append a new element to the │
│ Session queue. PointField is the field number of a point field │
│ that displays a scrolling area of records. PointRows is the │
│ total number of scrolling regions in the REPEAT area. │
│ LocatorField is an optional parameter that contains the field │
│ number of a locator field. Typing any displayable character │
│ activates the locator field. The USE variable of the locator │
│ field is a key component, so completing the locator field │
│ scrolls the scroll area to the first matching record. │
│ ImmediateFlag is an optional parameter that contains a 1 if │
│ the selected record is to be accessed each time the selector │
│ bar moves over a new record. IncrementFlag is an optional │
│ parameter that contains a 1, 2, 3, or 4 to request an │
│ incremental locator field that automatically locates a │
│ matching record after a pause in typing. Increment values │
│ of 2, 3, and 4 request upper case, lower case, and │
│ capitalized locator fields. An increment value of 1 uses │
│ the case entered by the operator. │
│ │
│ RepeatAction(File,Key,Index) │
│ │
│ Manages the behavior of the scroll area, locator field, and │
│ hot fields. File is the FILE to be scrolled. Key is KEY to │
│ be used to access the file. Index is the current position of │
│ the selector bar within the scroll area. Index is passed by │
│ address, because RepeatAction may change the value of Index. │
│ RepeatAction returns a code requesting one of the following │
│ actions: │
│ │
│ Set the first record and set the last record of a limited │
│ range of consecutive records. │
│ │
│ Reject a record by issueing GET(File,0) to dereference the │
│ record or indicate that a record is out of range by issueing │
│ NEXT(File) or PREVIOUS(File) to move the record position. │
│ │
│ Process the record under the selector bar │
│ │
│ Process a field or key that the repeat manager does not │
│ recognize. The selected record has been accessed from the │
│ file and display queue. │
│ │
│ Take action if there are no records to display. │
│ │
│ Clear the key fields subordinate to the locator field. │
│ │
│ EndRepeat │
│ │
│ Terminate the repeat session. Free position elements for this │
│ session from the Position queue. Free the last element from │
│ the Session queue. │
│ │
└────────────────────────────────────────────────────────────────────────────┘
INCLUDE('KEYCODES.EQU')
MAP
BeginRepeat(BYTE,BYTE,<BYTE>,<BYTE>,<BYTE>)
RepeatAction(FILE,KEY,*BYTE),BYTE
EndRepeat
END
RptSession QUEUE !Repeat session queue
Action BYTE ! Caller action
Process BYTE ! Internal process
Point BYTE ! Point field number
Immediate BYTE ! Process selected record
Locator BYTE ! Locator field number
Location STRING(40) ! Locator field contents
Length BYTE ! Locator contents length
Increment BYTE ! Incremental locator flag
Count BYTE ! Scroll item count
Item BYTE ! Current item (1 to Count)
Choice BYTE ! Selector bar position
LastChoice BYTE ! Last Selector position
Row BYTE ! Point field screen row
Col BYTE ! Point field screen column
Rows BYTE ! Point field rows
Cols BYTE ! Point field column width
Page STRING(1) ! Current page (F,L,blank)
FirstPage BYTE ! First page request flag
Base SHORT ! Base for RptPosition queue
Selected STRING(256) ! Selected record position
END
RptPosition QUEUE !Record position queue
STRING(256) ! Record Position
END
!Caller actions
NoAction EQUATE(0) ! No caller action
ProcessField EQUATE(2) ! Process another field
NoRecords EQUATE(3) ! No records to display
FilterRecord EQUATE(4) ! Filter a record
ResetFirst EQUATE(5) ! Set to first of a range
ResetLast EQUATE(6) ! Set to last of a range
ProcessSelected EQUATE(7) ! Process selected record
ClearRestOfKey EQUATE(8) ! Clear low fields of key
!Internal processes
InitSession EQUATE(1) ! Initialize repeat session
ProcessForward EQUATE(2) ! Process records forward
ProcessBackward EQUATE(3) ! Process records backward
ProcessSingle EQUATE(4) ! Process a single record
AcceptInput EQUATE(5) ! Accept keyboard input
LoChar EQUATE(32) !Lowest displayable char
HiChar EQUATE(127) !Highest displayable char
CODE !Dummy program
BeginRepeat PROCEDURE(PointField,PointRows,LocatorField,ImmediateFlag, |
IncrementFlag)
CODE
IF RECORDS(RptSession) THEN PUT(RptSession). !Save any current session
CLEAR(RptSession) !Clear the session record
Action = NoAction !Set no caller action
Process = InitSession !Initialize a repeat session
Point = PointField !Set Point field number
Locator = LocatorField !Set locator field number
Immediate = ImmediateFlag !Set immediate process flag
IF Locator THEN Increment = IncrementFlag. !If there is a locator field
Count = PointRows !Set item count
Row = ROW(Point) !Set point row
Col = COL(Point) !Set point column
Rows = PointRows * ROWS(Point) !Set point rows
Cols = COLS(Point) !Set point columns
Choice = 1 !Set top choice
LastChoice = 1 !Set top last choice
Base = RECORDS(RptPosition) !Set base position
ADD(RptSession,RECORDS(RptSession)+1) !Add the session record
RETURN !Return to caller
RepeatAction FUNCTION(File,Key,Index)
Delay EQUATE(50) !Time delay (1/2 second)
SpaceKey EQUATE(32) !Space bar keycode
TimeOut LONG,AUTO !Deadline time (.01 seconds)
CODE
CASE Action !Process caller's action
OF FilterRecord !Caller filtered the record
CASE POSITION(Key) !Check callers action
OF '' !The record is rejected
IF Process = ProcessSingle ! And previously accepted
GET(RptPosition,Base+Choice) ! Get the position element
DELETE(RptPosition) ! And delete it
Process = ProcessForward ! Display a new last
Item = RECORDS(RptPosition) - Base + 1 ! record forward
GET(RptPosition,RECORDS(RptPosition)) ! Get last display record
RESET(Key,RptPosition) ! Reset to last display
NEXT(File) ! Retrieve last record
END ! End IF
OF RptPosition !The record is accepted
CASE KEYCODE() ! While scrolling
OF DownKey ! with the DownKey
OROF PgDnKey ! or the PgDnKey
SCROLL(ROW,COL,ROWS,COLS,ROWS(Point)) ! Scroll forward
OF UpKey ! with the UpKey
OROF PgUpKey ! or the PgUpKey
SCROLL(ROW,COL,ROWS,COLS,-(ROWS(Point)))! Scroll backward
Index = 1 ! Point to top record
END ! End CASE
CASE Process ! Jump to current process
OF ProcessForward ! On forward processing
ADD(RptPosition,RECORDS(RptPosition)+1) ! Add new last position
IF RECORDS(RptPosition)-Base > Count ! If the page overflows
GET(RptPosition,Base+1) ! Get the first position
DELETE(RptPosition) ! And delete it
END ! End IF
DISPLAY
Item += 1 ! Increment current item
IF Index < Count ! If not bottom item
Index += 1 ! Increment index
END ! End IF
OF ProcessBackward ! On backward processing
ADD(RptPosition,Base+1) ! Add new first position
IF RECORDS(RptPosition) > Count ! If the page overflows
GET(RptPosition,RECORDS(RptPosition)) ! GET the last position
DELETE(RptPosition) ! And delete it
END ! End IF
DISPLAY
Item -= 1 ! Decrement current item
IF Index > 1 ! While not top item
Index -= 1 ! Decrement index
END ! End IF
OF ProcessSingle ! On a single record
SELECT(Point) ! Select the point field
Process = AcceptInput ! Get keyboard input
Selected = '' ! Clear selected position
END ! End CASE
ELSE !The record is out of range
SELECT(Point) ! Select the point field
Selected = '' ! Clear selected position
Process = AcceptInput ! Get keyboard input
END !End CASE
OF ProcessSelected !Caller processed a record
Selected = POSITION(Key) ! Set selected position
OF ProcessField !Caller processed a field
IF FIELD() <> Locator !For non-locator field
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator
END ! End IF
IF INRANGE(FIELD(),1,Point-1) ! From a prior field
FirstPage = 1 ! Request the first page
END ! End IF
END !End IF
IF SELECTED() = Point !If point field is selected
IF FirstPage !If first page is requested
DO FirstPage ! Display the first page
Action = ResetFirst ! Ask caller to first
RETURN(Action) ! record in range
ELSIF FIELD() <> Locator !From any field but a locator
CASE POSITION(Key) !Check the record
OF '' !If record was dereferenced
DO GetChoice ! Get selected record
IF POSITION(Key) = RptPosition ! If record is still there
Process = ProcessSingle ! Display one record
Action = FilterRecord ! Ask caller to filter
RETURN(Action) ! Return to caller
ELSE ! If record was deleted
DELETE(RptPosition) ! Delete its position
IF RECORDS(RptPosition) - Base = 0 ! If queue is now empty
DO LastPage ! Display the last page
Action = ResetLast ! Ask caller to reset to
RETURN(Action) ! last record in range
ELSE ! Otherwise
Do NewPage ! Display a new page
END ! End IF
END ! End IF
OF RptPosition !If record didn't move
Action = FilterRecord ! Ask caller to
Process = ProcessSingle ! filter one record
RETURN(Action) ! Return to caller
ELSE !If record moved
DO NewPage ! Display the new page
END !End CASE
END !End IF
ELSE !Else another field selected
IF FIELD() <> SELECTED() ! If selecting a new field
Process = AcceptInput ! Accept keyboard input
END ! End IF
END !End IF
OF NoRecords !Caller added a record
IF SELECTED() = Point !And selected the point field
DO FirstPage ! Display the first page
Action = ResetFirst ! Ask caller to reset to
RETURN(Action) ! first record in range
END ! End IF
OF ClearRestOfKey !Clear locator subfields
SELECT(Locator) ! Select the locator field
Process = AcceptInput ! Accept keyboard input
END !End CASE
LOOP
CASE Process !Jump to current process
OF InitSession !Start repeat session
Process = AcceptInput !Accept keyboard input
OF ProcessForward !Process records forward
IF Item <= Count ! If page is not full
NEXT(File) ! Read the next record
IF ~ERRORCODE() ! If a record was found
RptPosition = POSITION(Key) ! Save its position
Action = FilterRecord ! Ask caller to filter
RETURN(Action) ! Return to caller
END ! End IF
ELSE ! Else through filling page
Index = 1 ! Reselect top item
END ! End IF
SELECT(Point) ! Select the point bar
Selected = '' ! Clear selected position
IF KEYCODE() = CtrlPgUp or Page = 'F' ! On CtrlPgUp or first page
Index = 1 ! Point to top record
END ! End IF
Process = AcceptInput ! Get keyboard input
OF ProcessBackward !Process records backward
IF Item >= 1 ! If page is not full
PREVIOUS(File) ! Read the prior record
IF ~ERRORCODE() ! If a record was found
RptPosition = POSITION(Key) ! Save its position
Action = FilterRecord ! Ask caller to filter
RETURN(Action) ! Return to caller
END ! End IF
END ! End IF
SELECT(Point) ! Select the point bar
Selected = '' ! Clear selected position
IF KEYCODE() = CtrlPgDn ! On CtrlPgDn key
Index = Count ! Point to last record
END ! End IF
Process = AcceptInput ! Get keyboard input
OF AcceptInput !Get keyboard input
IF SELECTED() = Point !When selecting point field
IF RECORDS(RptPosition) - Base = 0 ! If there are no records
CASE Page ! Which page is displayed
OF 'F' ! On the first page
GET(File,0) ! Clear the current record
Action = NoRecords ! Ask caller for records
OF 'N' ! On a new page
DO LastPage ! Display the last page
Action = ResetLast ! Ask for last record
ELSE ! On any other page
DO FirstPage ! Display the first page
Action = ResetFirst ! Ask for first record
END ! End CASE
RETURN(Action) ! Return to caller
END !End IF
IF Immediate !For immediate processing
GET(RptPosition,Base+Index) ! Get selected position
IF Selected <> RptPosition ! If selector moved
DO GetChoice ! Get selected record
IF RptPosition = POSITION(Key) ! If deleted record
Action = ProcessSelected ! Ask to process record
RETURN(Action) ! Return to caller
ELSE ! Else
DO NewPage ! Rebuild the Queue
Action = ProcessField ! Ask to process record
RETURN(Action) ! Return to caller
END ! End IF
END ! End IF
END !End IF
IF Locator !If there is a locator field
ERASE(Locator) ! Erase locator contents
IF Increment ! If incremental locator
DO ShowLocator ! Show locator field
END ! End IF
END !End IF
IF Index > Count !If past bottom item
Index = Count ! Set to bottom item
ELSIF Index < 1 !Else If before top item
Index = 1 ! Set to top item
END !End IF
LastChoice = Index !Save selector position
END !End IF
ACCEPT !Enable the keyboard
CASE FIELD() !Jump to field edit routine
OF Locator !Process the locator field
IF CONTENTS(Locator) ! If locator is requested
IF Increment ! If incremental locator
Location = CONTENTS(Locator) ! Save location
Length = LEN(CLIP(Location)) ! Save location length
END ! End IF
SELECT(Point) ! Select the point field
DO NewPage ! Display a new page
IF KEYCODE() = DownKey ! If completed with DownKey
SETKEYCODE(0) ! Clear the keycode
END ! End IF
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END ! End IF
OF Point !Process the point field
Choice = Index ! Save selector bar position
IF SELECTED() <> Point THEN CYCLE. ! Process any new fields
CASE KEYCODE() ! Jump to key edit routine
OF LoChar TO HiChar ! For any locator character
OROF BSKey OROF SpaceKey ! or backspace or space
IF Locator ! If there is a locator
IF Increment ! On incremental locator
DO GatherKeys ! Gather keystrokes
IF Location ! If not blank
PRESS(SUB(Location,1,Length)) ! Press the string
PRESS(DownKey) ! Complete the field
SELECT(Locator) ! Select locator
END ! End IF
ELSE ! On standard locator
PRESS(KEYCODE()) ! Press in the keycode
SELECT(Locator) ! Select locator field
END ! End IF
Action = ClearRestOfKey ! Ask caller to clear
RETURN(Action) ! subordinate fields
END ! End IF
OF CtrlPgUp !Process the Ctrl-PgUp key
Index = 1 ! Reset index to top record
BLANK(Row,Col,Rows,Cols) ! Clear the screen
DO FirstPage ! Display the first page
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator field
END ! End IF
Action = ResetFirst ! Ask caller to reset to
RETURN(Action) ! first record in range
OF PgUpKey !Process the PgUp key
IF LastChoice <> 1 ! If not at the top
Choice = 1 ! Selector bar to top
Index = 1 ! Selector bar to top
ELSE ! From the top
Page = '' ! Clear page flag
Process = ProcessBackward ! Display a new page
Item = Count ! of records backward
GET(RptPosition,Base+1) ! Reset to the top
RESET(Key,RptPosition) ! record displayed
PREVIOUS(File) ! Point to prior record
END ! End IF
OF UpKey !Process the up arrow
IF Index = 1 ! From the top line
Page = '' ! Clear page flag
Process = ProcessBackward ! Display a single
Item = 1 ! record backward
GET(RptPosition,Base+1) ! Reset to the top
RESET(Key,RptPosition) ! record displayed
PREVIOUS(File) ! Point to prior record
END ! End IF
OF DownKey !Process the down arrow
IF Index = Count ! From the bottom line
Page = '' ! Clear page flag
Process = ProcessForward ! Display a single
Item = Count ! record forward
GET(RptPosition,RECORDS(RptPosition)) ! Reset to the bottom
RESET(Key,RptPosition) ! record displayed
NEXT(File) ! Point to the next record
END ! End IF
OF PgDnKey !Process the PgDn key
IF LastChoice <> Count ! If not at the bottom
IF RECORDS(RptPosition) > Base ! For a partial screen
Index = RECORDS(RptPosition) - Base! Set index to bottom
ELSE ! Else
Index = Count ! Set index to bottom
END ! End IF
Choice = Index ! Set the choice
ELSE ! From the bottom
Page = '' ! Clear page flag
Process = ProcessForward ! Display a new page
Item = 1 ! of records forwards
GET(RptPosition,RECORDS(RptPosition)) ! Reset to the bottom
RESET(Key,RptPosition) ! record displayed
NEXT(File) ! Point to next record
END ! End IF
OF CtrlPgDn !Process the Ctrl-PgDn Key
IF RECORDS(RptPosition) > Base ! For a partial screen
Index = RECORDS(RptPosition) - Base ! Set index to last record
ELSE ! Else
Index = Count ! Set index to bottom
END ! End IF
BLANK(Row,Col,Rows,Cols) ! Clear the scroll area
DO LastPage ! Display the last page
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator field
END ! End IF
Action = ResetLast ! Ask caller to reset to
RETURN(Action) ! last record in range
OF LeftKey !For left arrow key,
OROF Rightkey ! right arrow key,
OROF Homekey ! Home key,
OROF Endkey ! End key,
OROF MouseLeft !And a mouse click
! Don't do anything
ELSE !For any other key
DO GetChoice ! Get selected record
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END !End CASE KEYCODE()
IF Increment !If incremental locator
DO ClearLocator ! Clear locator field
END !End
ELSE !Process any other field
IF FIELD() >= Point OR FIELD() < 0 ! If menu or after point
DO GetChoice ! Get selected record
END ! End IF
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END !End CASE FIELD()
END !End CASE repeatProcess
END !End LOOP
GetChoice ROUTINE !Get selected record
GET(RptPosition,Base+Choice) ! Get selected position
RESET(Key,RptPosition) ! Reset to that record
NEXT(File) ! Read the record
FirstPage ROUTINE !Display first page
FirstPage = 0 ! Clear first page request
Page = 'F' ! Set first page flag
DO DeletePage ! Delete the old page
Choice = 1 ! Reset selector bar
Process = ProcessForward ! Display a new page
Item = 1 ! of records forward
SET(Key) ! Set to the first record
LastPage ROUTINE !Display last page
Page = 'L' ! Set last page flag
DO DeletePage ! Delete the old page
Choice = Count ! Reset selector bar
Process = ProcessBackward ! Display a new page
Item = Count ! of records backward
SET(Key) ! Set to the last record
Index = Count ! Set to the last row
NewPage ROUTINE !Display a new page
Page = 'N' ! Set new page flag
DO DeletePage ! Delete the old page
BLANK(Row,Col,Rows,Cols) ! Blank screen for next page
SET(Key,Key) ! Set to the new record
Choice = 1 ! Selector bar to top
Process = ProcessForward ! Display a new page
Item = 1 ! of records forward
Index = 1 ! from the top record
DeletePage ROUTINE !Delete the current page
LOOP WHILE RECORDS(RptPosition) > Base ! Delete all position
GET(RptPosition,RECORDS(RptPosition)) ! elements after the
DELETE(RptPosition) ! base position
END ! End LOOP
GatherKeys ROUTINE !Gather locator keystrokes
DO AppendKey ! Append pending keystroke
TimeOut = CLOCK() + Delay ! Set the time delay
LOOP UNTIL CLOCK() > TimeOut !Loop until time out
IF KEYBOARD() ! If there is a keystroke
ASK ! Read the keystroke
DO AppendKey ! Append the keystroke
DO ShowLocator ! Show the user
TimeOut = CLOCK() + Delay ! Reset the time delay
END ! End IF
END !End LOOP
AppendKey ROUTINE !Append keystroke to locator
CASE KEYCODE() ! Process the keystroke
OF LoChar TO HiChar OROF SpaceKey ! For a character
IF Length < COLS(Locator) ! If it will fit
Location = SUB(Location,1,Length) & CHR(KEYCODE()) ! Add it on
Length += 1 ! Increment the length
END ! End IF
OF BSKey ! For a backspace
IF Length > 0 THEN Length -= 1. ! Decrement the length
Location = SUB(Location,1,Length) ! Shorten the string
EXECUTE Increment - 1 ! For locator case
Location = UPPER(Location) ! Upper case location
Location = LOWER(Location) ! Lower case location
Location = UPPER(SUB(Location,1,1)) | ! Capitalize location
& LOWER(SUB(Location,2,SIZE(Location)-1))
END ! End EXECUTE
END ! End CASE
ClearLocator ROUTINE !Clear locator field
Location = '' ! Clear field string
Length = 0 ! Zero field length
DO ShowLocator ! Show locator field
ShowLocator ROUTINE !Show locator field contents
SHOW(ROW(Locator),COL(Locator),SUB(Location,1,COLS(Locator)))
EndRepeat PROCEDURE
CODE
LOOP WHILE RECORDS(RptPosition) > Base !Delete all position
GET(RptPosition,RECORDS(RptPosition)) ! elements after the
DELETE(RptPosition) ! base position
END !End LOOP
DELETE(RptSession) !Delete the current session
IF RECORDS(RptSession) !For any prior session
GET(RptSession,RECORDS(RptSession)) ! Get the session element
END !End IF
RETURN !Return to caller